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I.  Introduction 


Understanding  the  flow  of  energy  through  a  bounded  waveguide  region  is  en¬ 
hanced  by  the  ability  to  visualize  surface-current  vector  fields.  Also,  determining  the 
position  and  size  of  slots  cut  into  the  wall  of  a  waveguide  requires  a  knowledge  of 
the  current-flow  magnitude  and  direction  on  the  inside  surface.  Applications  have 
been  developed  to  represent  waveguide  modes  [l]-[3],  radiation  fields  [4],  and  static 
fields  [5]-[6];  however,  all  are  limited  to  only  two  dimensions.  These  methods  usually 
exclude  the  flow  direction  of  each  vector  and  show  only  the  tangent  line.  The  mag¬ 
nitude  either  is  not  shown  or  is  represented  simply  by  variable  line  density  or  line 
thickness. 

The  purpose  of  this  study  is  to  develop  a  method  of  plotting  the  magnitude  and 
direction  of  numerically  computed  current  induced  on  the  inside  surface  of  a  rect¬ 
angular  or  circular  waveguide.  The  inside  surface  is  assumed  to  be  described  by 
a  triangular  mesh.  This  is  consistent  with  a  finite-element  analysis  using  tetrahe¬ 
dral  elements  of  the  interior  of  a  waveguide.  Since  the  waveguide  surface  can  be 
described  by  two  variables  of  an  orthogonal  coordinate  system,  the  vector  field  can 
be  represented  by  a  simple  two-dimensional  to  three-dimensional  mapping.  This  al¬ 
lows  all  processing  to  be  done  in  two  dimensions.  The  procedure  will  be  to  combine 
the  three-dimensional  contoured-surface  representation  technique  developed  in  [7]-[8] 
with  a  two-dimensional  vector  drawing  algorithm.  The  flow  will  be  indicated  by  a 
continuous  line  with  arrowhead  markers,  and  the  normalized  magnitude  by  grayscale- 
shaded  contours. 
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II.  Drawing  Vectors  on  Triangular  Grids 


Tetrahedral  volume  elements  are  used  frequently  for  the  finite-element  analysis  of 
the  interior  of  a  waveguide.  This  is  especially  true  if  the  waveguide  is  nonuniformly 
filled,  contains  a  scattering  obstacle,  or  has  a  nonplanar  surface.  The  tetrahedral 
element  has  four  sides,  which  are  all  triangles.  This  implies  that  the  surface  of  the 
waveguide  is  approximated  by  a  triangular  mesh,  so  that  the  numerical  value  of  both 
vector  components  is  computed  at  each  node.  Since  three  points  determine  a  plane, 
a  linear  interpolation  function  is  implied  over  every  triangle.  Therefore,  each  vector 
component  has  piecewise  continuity  between  adjacent  triangles. 

The  numbering  scheme  for  the  nodes  and  triangles  of  a  region  is  completely 
arbitrary.  Figure  l  indicates  a  possible  configuration  for  six  nodes  and  four  triangles. 
The  convention  used  in  this  study,  to  establish  the  connection  between  a  triangle 
number  and  the  three  associated  node  numbers,  is  to  store  the  relationship  in  a 
matrix  called  the  triangle-to-node  connection  matrix,  denoted  by  C.  This  matrix  is 
defined  when  the  original  triangular  grid  is  formed.  The  relevant  matrix  for  the 
configuration  of  Fig.  1  is  given  as 


C  = 


■1 

2 

3 

.3 


2  3- 

3  4 

4  5 

5  6. 


(1) 


where  each  row  represents  a  triangle  and  each  column  represents  one  of  the  three 
triangle  nodes.  This  matrix  is  used  for  the  indirect  addressing  of  the  coordinates  of 
each  triangle. 

The  matrix  C  implicitly  contains  enough  information  to  yield  the  triangle-to- 
triangle  connection  relationship  between  a  particular  triangle’s  three  vertex  nodes 
and  all  other  triangles  connected  to  one  of  these  nodes.  Unfortunately,  to  establish 
this  relationship  the  entire  matrix  must  be  searched.  This  is  quite  time  consuming, 
but  it  can  be  avoided  by  precomputing  an  auxilary  matrix  called  the  node-to-triangle 
connection  matrix,  denoted  by  T.  For  the  geometry  of  Fig.  1,  T  is  given  by 
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Fig.  l.  Node  and  Triangle  Connections 


-1  0  0  0  0  0- 

1  2  0  0  0  0 

1  2  3  4  0  0 

2  3  0  0  0  0 

3  4  0  0  0  0 

.4  0  0  0  0  0. 


(2) 


where  each  row  represents  a  node  number  and  each  column  gives  a  triangle  number 
connected  to  that  node.  The  formation  of  this  matrix  is  trivial  once  C  is  known.  For 
a  triangular  grid,  there  will  be  no  more  than  six  triangles  connected  to  each  node. 
This  implies  that  there  are  no  more  than  twelve  triangles  connected  to  any  particular 
triangle 

The  interpolation  function  of  a  vector  in  the  plane  of  each  triangle  is  given  by 


I  —  /z£  4-  fy  y  (3) 

where 

/„  =  Ax  +  By  +  E  (4) 

fx  =  Cx  +  Dy  +  F.  (5) 

By  equating  the  function  to  the  numerical  values  at  the  three  vertices  of  the  triangle, 
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the  coefficients  are  computed  as 


A  =  [/„  i(j/2  -  yz)  -  fy  2(1/1  -  3/3)  +  /«3(yi  -  2/2)]/^  (6) 

B  =  {~fyl(X2  -  X3)  +  /y2(xi  -  X3)  -  /y3(ll  -  X2)]/tV  (7) 

E  =  [/vi(x2y3  -  x3y2)  -  fyzixiVz  ~  x3y2)  +  fyz{xxy2  -  x2yx))/w  (8) 

c  =  [fx  1(3/2  -  3/3)  -  /* 2(3/1  -  3/3)  +  /a3(3/l  -  V2)]/w  (9) 

D  =  [-/* i(x2  -  x3)  +  /*2(x  1  -  X3)  -  /x3(xi  -  x2)]/to  (10) 

F  =  [fx i(x2y3  -  x3y2)  -  /x2(xii/3  -  x3i/2)  +  fX3{xiy2  -  x2yx)]/w  (11) 

where 

w  =  xiy2  -  xxy3  -  x2y\  4-  x3yi  +  x2y3  -  x3y2.  (12) 


For  a  given  an  observation  point,  the  appropriate  triangle  is  located  using  C  and  T, 
then  the  magnitude  and  direction  of  the  vector  field  can  be  computed  using  Eqs.  (4) 
and  (5). 

Although  each  component  of  the  interpolated  vector  field  changes  linearly  across 
each  triangle,  the  path  of  the  vector  itself  is  nonlinear.  The  slope  of  a  line  tangent 
to  the  vector  field  at  any  point  in  the  triangle  is  given  by 

dy  Ax  +  By  +  E 

dx  Cx  +  Dy  +  F'  V  ' 

This  is  a  nonlinear  first-order  differential  equation.  For  a  given  starting  point  within  a 
triangle,  a  vector  path  is  uniquely  defined  by  the  solution  to  this  differential  equation. 
(The  solution  is  given  in  Appendix  A.)  Unfortunately,  the  solution  is  an  implicit 
function  of  the  form  W(x,y)  =  0,  which  is  not  very  convenient  for  rapid  plotting. 
Fortunately,  the  method  proposed  and  used  in  this  study  is  much  faster  and  easier 
to  implement.  Given  some  initial  point,  the  vector  is  simply  incremented  in  the 
positive  or  negative  direction.  This  simple  method  allows  arrows  to  be  placed  and 
accurately  spaced  on  the  lines.  Also,  the  plotting  speed  is  controlled  entirely  by  the 
step  size.  The  step  size  could  be  adaptively  adjusted  to  reflect  the  variation  in  the 
vector  direction,  although  that  has  not  been  attempted  here.  The  vector  position  is 


incremented  as 


xn+1  =  xn  +  A-fi-r 

\fn\ 

y'*+l  =  y”  +  AT£T 


I/" 

where  A  is  a  positive  or  negative  adaptive  step  size  and 


|r|  =  vto  +  c/y")2- 


The  vector  length  is  accumulated  as 


(14) 

(15) 


(16) 


zn+1  =  r  +  y/(xn+1  -  xn)2  +  (yn+x  -  yn)2  (17) 

and  is  used  to  provide  equal  spacing  between  arrowhead  markers. 

This  method  is  designed  for  two-dimensional  vector  fields.  However,  since  there 
is  a  point-to-point  mapping  between  a  rectangular  two-dimensional  region  and  the 
corresponding  surface  of  the  three-dimensional  waveguide,  then  the  vector  lines  can 
be  mapped  onto  the  waveguide  surface.  The  three-dimensional  surface  is  drawn  by 
the  method  developed  in  [7]- [8].  Once  this  is  complete,  the  visible  portion  of  each 
vector  fine  is  drawn  onto  the  surface. 
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III.  Initial,  Terminal,  and  Critical  Points 


Each  vector  has  an  initial  point  and  a  terminal  point.  In  some  cases  these  points 
may  even  coincide.  Choosing  an  appropriate  initial  point  requires  some  knowledge 
about  the  points  at  which  the  vector  magnitude  goes  to  zero.  These  are  called  critical 
points  [9]-[12].  For  an  interactive  computer  application,  a  convenient  way  to  locate 
the  critical  points  is  to  view  a  contour  plot  of  the  magnitude  of  one  or  both  of  the 
field  components.  A  region  can  be  selected  by  means  of  a  cursor  and  a  limited 
numerical  search  can  be  performed.  Usually,  a  vector’s  initial  point  is  in  a  region  of 
high  magnitude  and  a  terminal  point  is  either  a  boundary  point  or  a  critical  point. 

Several  types  of  critical  points  can  be  used  to  characterize  the  flow  of  a  vector 
field.  Each  type  is  based  on  the  eigenvalues  of  the  Jacobian  matrix  evaluated  in  the 
vicinity  of  the  critical  point.  Let  J  denote  the  Jacobian  of  the  vector  components  at 
some  specified  point  so  that 


j  = 


*/« 
-  dx 


a/v 
~Sy  . 


C  D~ 
A  B 


(18) 


For  a  triangular  grid  with  vertex-specified  vector  values,  the  Jacobian  is  constant 
over  each  triangle.  The  type  of  critical  point  can  be  determined  by  looking  at  the 
eigenvalues  of  the  Jacobian  for  a  particular  triangle.  Letting  I  denote  the  identity 
matrix,  the  eigenvalue  equation  is  formed  by  taking  the  determinant 


det|J  -  7II  =  0  (19) 

which  yields  a  quadratic  equation  in  the  variable  7: 


72  -  (£  +  C)7  +  BC  -  AD  =  0. 

This  equation  has  the  solution 

7  =  7r  +  J7i  =  ^  [(B  +  C)  ±  y/(B  +  C)*-4(BC-AD)]  . 


(20) 


(21) 
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(a) 


(b) 


(c) 


Fig.  2.  Critical  Points  for  (a)  Diverging,  (b)  Converging,  or  (c)  Closed  Loop  Vector 
Fields 


Figure  2  shows  the  most  common  critical  points  encountered  in  plotting  vector  fields 
in  electromagnetics.  Figure  2(a)  shows  a  field  that  converges  to  a  point;  this  is 
represented  mathematically  as  >  <  0  and  ~u  =  0.  Figure  2(b)  shows  a  field  that 
diverges  from  a  point;  this  is  represented  mathematically  as  7r  >  0  and  7<  =  0.  Figure 
2(c)  shows  a  field  that  forms  closed  loops;  this  is  represented  mathematically  as 
It  -  0  and  7i  ^  o.  The  diverging  or  converging  critical  points  are  sufficient  to  describe 
a  surface-current  vector  field.  Closed-loop  critical  points  are  necessary  for  drawing 
propagating  electric  and  magnetic  fields,  such  as  those  in  the  interior  of  the  waveguide. 

Once  the  critical  points  have  been  established,  appropriate  initial  points  can  be 
specified.  Since  the  vector-direction  error  accumulates  with  each  increment,  vectors 
are  started  at  points  of  large  magnitude  so  that  roundoff  error  can  be  minimized. 
Each  vector  is  drawn  in  two  directions  until  a  terminal  point  is  reached.  This  reduces 
the  error  by  half  and  causes  the  greatest  error  to  occur  at  the  terminal  points  (which 
are  usually  critical  points).  It  can  also  help  provide  symmetry  in  the  vector  lines 
when  appropriate.  For  the  purposes  of  this  study,  vectors  are  drawn  in  groups  that 
have  initial  points  spaced  equally  along  a  line.  The  boundary  points  for  each  line  can 
be  easily  controlled  interactively  by  a  cursor. 
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IV.  TE  Wave  Surface  Currents 


Although  the  plotting  procedure  is  designed  to  handle  numerically  computed 
data,  for  convenience  it  is  tested  by  means  of  well-known  analytic  expressions  for  the 
surface  current  induced  on  the  inside  of  a  rectangular  or  circular  waveguide  excited 
by  transverse  electric  (TE)  waves.  The  magnitude  and  direction  of  the  current  flow 
is  shown  by  superimposing  the  vector  lines  onto  a  contour  plot  of  the  normalized 
magnitude.  The  vector  field  can  be  viewed  either  on  a  two-dimensional  surface  or  on 
the  actual  three-dimensional  surface. 

The  TEmn-mode  magnetic-field  components  for  a  rectangular  waveguide  centered 
about  the  origin  such  that  -a/2  <  x  <  a/2  and  -b/2  <y<b/2  are  given  by 


Hx  —  -  sin  rpx  cos  ipy  s in{ut  -  0z) 

(22) 

Hy  —  -  T~n^^°  cos  rpx  sin  rpy  sin (ut  -  0z ) 

(23) 

Hz  =  Hq  cos  Tpx  cos  ipy  cos (ut  -  (3z) 

(24) 

where  0  =  \Ao  -  ^2  =  rmt/a,  ky  =  nir/b,  k*  =  k%  +  k%,  rpx 

=  kx{x  -  a/2),  and  = 

kv(y~h/2)-  Defining  a  unit  vector  normal  to  each  inside  wall 
components  on  the  inside  of  the  waveguide  are  given  by 

as  n,  the  surface  current 

Hx  —  HyHz  nzHy 

(25) 

Ky  =  nzHx  -  nxHz 

(26) 

Kz  —  71  XHy  7lyHX 

(27) 

Figure  3  shows  the  magnitude  and  direction  of  the  surface-current  for  the  TE10- 
mode  for  t  =  0.  The  waveguide  dimensions  are  a  =  1A0,  b  =  0.5Ao,  and  0  <  z  <  brc/0. 
There  are  27  nodes  across  each  wide  side,  9  samples  across  each  narrow  side,  and  62 
samples  along  the  longitudinal  direction.  This  results  in  a  total  of  4278  nodes  and 
8296  triangles.  Figure  4  shows  the  same  vector  field  mapped  to  the  outside  surface  of 
the  waveguide. 

The  TE„m-mode  magnetic  field  components  for  a  circular  waveguide  of  radius  a 
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axe  given  by 


-nkftHo  jn(kcr)  .  a  . 

Ha  =  — - r - sm(n<£)  sin(urt  -  /3z) 

fccp  kcr 

Hz  =  H0Jn(kcr)  cos(n4>)  cos(urt  -  0z) 


(28) 

(29) 


where  kc  =  j/nm/a.  The  variable  p'nm  is  the  mth  root  of  dJn(kcr)/dr  =  0  evaluated  at 
r  =  a.  The  surface  current  components  on  the  inside  of  the  waveguide  are  given  by 

K4  =  Hz  (21) 

Kt  =  -Ha-  (22) 

Figure  5  shows  the  magnitude  and  direction  of  the  surface  current  for  the  TEn  mode 
for  t  =  0.  The  waveguide  has  radius  a  =  1A0  and  length  5n/0  in  the  range  0  <  z  <  5ir/0. 
There  are  45  nodes  in  the  4>  direction  and  62  nodes  in  the  longitudinal  direction,  for  a 
total  of  2790  nodes  and  5368  triangles.  Figure  6  shows  the  same  vector  field  mapped 
to  the  outside  surface  of  the  waveguide. 
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Fig.  3.  Magnitude  and  Direction  of  TEio  Surface  Current  Plotted  on  Unfolded 
Rectangular  Waveguide 
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2n/p  3ji/P  4n/p  5n/p 


Fig.  4.  Magnitude  and  Direction  of  TEio  Surface  Current  Plotted  on  Rectangular 
Waveguide 
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Fig.  5.  Magnitude  and  Direction  of  TEn  Surface  Current  Plotted  on  Unfolded 
Circular  Waveguide 


17 


2 n/p  3n/p  4*/p  5n/p 


Fig.  6.  Magnitude  and  Direction  of  TEn  Surface  Current  Plotted  on  Circular 
Waveguide 
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VI.  Conclusion 


An  algorithm  has  been  presented  for  plotting  the  magnitude  and  direction  of 
the  current  induced  on  the  inside  surface  of  a  rectangular  or  circular  waveguide. 
The  algorithm  is  capable  of  plotting  either  a  two-  or  three-dimensional  view  of  the 
surface-current  field.  The  use  of  a  triangularized  mesh  is  consistent  with  the  output 
generated  by  a  finite-element  solution.  Test  cases  for  the  lower-order  modes  of  a 
rectangular  and  circular  waveguide  yielded  excellent  results. 
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Appendix  A:  Vector-Line  Differential  Equation  Solution 


The  slope  of  a  line  tangent  to  the  vector  field  over  a  triangle  determines  a  first- 
order  nonlinear  differential  equation  of  the  form 

dy  _  Ax  +  By  +  E 

dx  Cx  +  Dy  +  F'  K  ’ 

The  solution  of  this  differential  equation  is  given  by  Davis  [Al]  and  is  presented 
below.  The  first  step  is  to  convert  the  equation  to  homogeneous  form  through  the 
definitions 


x  =  u  +  h  ( A2 ) 

y  =  v  +  g.  (.A3) 

Substituting  these  expressions  into  Eq.  (Al)  yields  the  homogeneous  differential  equa¬ 
tion 


dv  Au  +  Bv 
du  Cu  +  Dv 

where  it  is  assumed  that  h  and  g  satisfy  the  linear  equations 


(A3) 


Ah  +  Bg  =  -E 

(A4) 

Ch  +  Dg  =  -F 

(A5) 

such  that 


,  BF  -  DE 
AD-BC 
CE  -  AF 
9  ~  AD-BC' 


(A6) 

(AT) 


Assuming  that  u  >  0  is  satisfied  over  the  triangle,  define  the  variable  s  =  v/u  and 
substitute  into  Eq.  (A4)  such  that 


dv 

du 


=  3  +  u 


ds 

du' 


(A8) 
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This  equation  can  then  be  separated  as 

1  ,  C  +  Ds 

udu  A  +  (B-C)s-Ds*ds 

to  allow  the  integration  of  both  sides,  yielding  an  implicit  function  of  the  form 


W(x,y)  =  0. 


(-410) 


This  function  can  be  expressed  as 


W(x,y)  =ln(x-h)~L(x,y)  +  co 


(All) 


where 


C  +  Ds 

A  +  (B  ~  C)s  —  Ds2 


(-412) 


and  co  is  an  integration  constant  chosen  to  match  the  initial  position  of  the  vector. 
The  integral  identity  has  the  form  given  by  [A2]: 

/  [r+r#-+^-w] *  =  DS]  +  H(.)  (A13) 


where 


#(«)» 


B  +  C  ^  \B  —  C  —  2Ds 
— j, —  tan  - - - 

fl  +  C,  \B-C~T-2Ds]  .  n 

2 T  [ B-C  +  T-2Ds\  A<° 


A  >  0 


(-414) 


A  =  -4 AD  -  (B  -  Cf 
T=y/\A\. 


(A15) 

(-416) 


This  identity  allows  Eq.  (A12)  to  be  evaluated  as 


L(x,y)  =  ln(z  -  h)  -  -  In [A{x  -  hf  +  {B-  C)(x  -  h)(y  -  g)  -  D(y  -  g )2] 
+  H(x,y) 


(-417) 


where 


H(x,y)  = 


A>0 

B  +  C  ((B-C-T)(x-h)-2D(y-g)} 

2T  m[(B-C  +  r)(x-/i)-22>(y-y)J  a<U 


In  \{B-‘ 

1(5-- 


A  <0 


(-418) 
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Thus,  Eq.  (All)  can  be  written  as 

W(x,  y)  =  1  ln[i4(x  -  h)2  +  (B  -  C)(x  -  h)(y  -  g)  -  D(y  -  g )2]  -  H (x,  y)  +  cq. 

(A19) 

The  implicit  form  of  the  equation  of  the  line  makes  this  solution  fairly  slow 
to  plot  a  vector  field.  However,  it  can  be  a  useful  way  to  judge  interactively  the 
appropriateness  of  the  step  size.  A  viewer-selected  triangle  can  be  enlarged  and 
the  vector  drawn  using  either  the  incremental  method  described  previously,  or  the 
analytic  solution.  A  comparison  of  both  methods  can  indicate  the  correctness  of  the 
step  size  or  the  triangle  grid  size. 
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Appendix  B:  Computer  Programs 


This  appendix  contains  the  programs  and  subroutines  used  to  generate  the  graph¬ 
ics  found  in  this  report.  All  source  code  is  written  in  standard  Fortran  77  [Bl] .  The 
output  graphic  is  generated  as  an  encapsulated  PostScript  (EPS)  file  [B2]-[B4].  The 
program  wavedr  generates  the  geometry  of  the  waveguide,  as  well  as  that  of  the  node- 
to-triangle  matrix  and  the  triangle-to-node  matrix.  The  program  unfold  plots  the 
surface-current  vector  field  on  an  unfolded  circular  or  rectangular  waveguide.  The 
program  FLDREC  plots  the  surface-current  vector  field  directly  on  the  outside  surface 
of  a  rectangular  waveguide.  The  program  FLDCIR  plots  the  surface-current  vector 
field  directly  on  the  outside  surface  of  a  circular  waveguide.  Figure  B.l  shows  the 
interdependency  of  the  programs  and  subroutines. 
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Fig.  B.l  Program  and  Subroutine  Dependencies 
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PROGRAM  WAVEDR 

****************************************************************** 


*  THIS  PROGRAM  GENERATES  THE  DATA  FILES  FOR  PLOTTING  SURFACE  * 

*  CURRENT  MAGNITUDE  AND  DIRECTION  ON  A  RECTANGULAR  OR  CIRCULAR  * 

*  WAVEGUIDE  AT  TIME  T=0.  * 

****************************************************************** 

*  TIMOTHY  J.  PETERS  LAST  UPDATED  * 

*  THE  AEROSPACE  CORPORATION  5/14/92  * 

*  2350  EAST  EL  SEGUNDO  BOULEVARD  * 

*  EL  SEGUNDO,  CA  90245  * 


****************************************************************** 
PARAMETER  (MN=6000,MT=12000,MP=6) 

REAL*4  U(MN) ,V(MN) ,KC2 
INTEGERS  N2T(MT,3),T2N(MN,MP) 

PI= . 3141593E+01 

****************************************************************** 


*  INPUTS:  * 

*  * 

*  MN  -  MAXIMUM  NUMBER  OF  NODES.  * 

*  MT  -  MAXIMUM  NUMBER  OF  TRIANGIE"  * 

*  MP  -  MAXIMUM  NUMBER  OF  TRUNKS  CONNECTED  TO  A  NODE.  * 

*  IGEO  -  IGE0=1  (RECTANGULAR)  IGE0=2  (CIRCULAR)  WAVEGUIDE.  * 

*  A  -  SIDE  WIDTH  -  A/2  <=X<=A/2  FOR  RECTANGULAR  GUIDE  OR  * 

*  RADIUS  FOR  CIRCULAR  GUIDE  (WAVELENGTHS) .  * 

*  B  -  SIDE  WIDTH  -B/2  <=Y<=B/2  FOR  RECTANGULAR  GUIDE.  * 

*  KM  -  NUMBER  OF  LONGITUDINAL  HALF  CYCLES.  * 

*  M.N  -  MODE  NUMBERS  FOR  TE_{MN>  FOR  RECTANGULAR  GUIDE.  * 

*  N.M  -  MODE  NUMBERS  FOR  TE_{NM>  FOR  CIRCULAR  GUIDE.  * 

*  NUA  -  NUMBER  OF  POINTS  ALONG  X  DIRECTION .  * 

*  NUB  -  NUMBER  OF  POINTS  ALONG  Y  DIRECTION.  * 


****************************************************************** 

IGE0=2 

IF  (IGEO  .EQ.  1)  THEN 

**************************************************************** 

*  RECTANGULAR  WAVEGUIDE.  * 

**************************************************************** 
A=1 .0 

B=0.5 

M=1 

N=0 

KM-5 

NV=62 

NUA=27 

NUB =9 

KC2=(M*PI/A) * (M*PI/A)  +  (N*PI/B>  * (N*PI/B) 

BETA=SQRT (4*PI*PI-KC2) 

C-KM*PI/BETA 
NU=2* (NUA+NUB) -3 
NN=NU*NV 

NT=2*(NU-1)*(NV-1) 

**************************************************************** 

*  GENERATE  THE  N2T  COORDINATES  AND  THE  CONNECTION  MATRIX.  * 

**« ■ ************************************************************ 
CALL  RECGRD(A,B,C,NUA,NUB,NU,NV,MN,MT,U,V,N2T) 
**************************************************************** 

*  WRITE  OUT  THE  COORDINATE  DATA  AND  VECTOR  FUNCTION  DATA  TO  A  * 

*  FILE.  * 

**************************************************************** 
CALL  RECDAT(A,B,C,KM,NUA,NUB,NV,NN,MN,U,V,M,N) 
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60  ELSE 

61  NU=45 

62  NV=62 

63  NN=NU*NV 

64  NT=2*(NU-1)*(NV-1) 

65  A=0 . 5 

66  N=1 

67  M=1 

68  PNL=ROOT(N,M) 

69  KC2=PNL*PNL/(A*A) 

70  BETA=SQRT(4*PI*PI-KC2) 

71  KM=5 

72  C=KM*PI/BETA 

73  CALL  CYLGRD(A,C,NU,NV,MN,MT,U,V,N2T) 

74  C  **************************************************************** 

75  C  *  WRITE  OUT  THE  COORDINATE  DATA  AND  VECTOR  FUNCTION  DATA  TO  A  * 

76  C  *  FILE.  * 

77  C  **************************************************************** 

78  CALL  CYLD  iT(A,C,KM,NU,NV,NN,MN,U,V,NfM) 

79  END  IF 

go  C  ****************************************************************** 

81  C  *  WRITE  OUT  THE  NODE  TO  TRIANGLE  CONNECTION  DATA.  * 

32  C  ****************************************************************** 

?3  OPEN (UNIT“1 , FILE= » N2TDAT » ) 

84  WRITE(1 , *)  NT 

85  DO  1  1*1 ,  NT 

86  WRITEd.O  N2T(I,1)  ,N2T(I,2)  ,N2T(I,3) 

87  1  CONTINUE 

88  CLOSE(l) 

89  C  ****************************************************************** 

90  C  *  GENERATE  THE  MATRIX  OF  TRIANGLES  CONNECTED  TO  THE  SAME  N2T.  * 

91  C  ****************************************************************** 

92  CALL  TC0NEC(MT,N2TfNT,MN,MP,T2N) 

93  WRITEC*,*)  ’TRIANGLE  TO  NODE  CONNECTION  MATRIX  GENERATED’ 

94  OPEN (UNIT= 1 , FILE- ’ T2NDAT ’ ) 

95  WRITEd,*)  NN 

96  DO  2  1=1, NN 

97  WRITEd,*)  T2N(I,1) ,T2N(I,2) ,T2N(I,3) ,T2NCI,4) ,T2N(I,5) ,T2N(I,6) 

98  2  CONTINUE 

99  CLOSE(l) 

ioo  END 

1  SUBROUTINE  RECGRD(A,B,C,NUAfNUB,NUlNV,MN,MT,U,V,N2T) 

2  C  ****************************************************************** 


3  C  *  THIS  SUBROUTINE  GENERATES  THE  UNFOLDED  COORDINATES  OF  A  * 

4  C  *  SECTION  OF  RECTANGULAR  WAVEGUIDE.  THESE  COORDINATES  REPRESENT  * 

5  C  *  THE  VERTICES  OF  TRIANGLES.  NODE  TO  TRIANGLE  CONNECTION  MATRIX  * 

6  C  *  IS  ALSO  GENERATED.  * 

7  C  ****************************************************************** 

8  C  *  INPUTS:  * 

9  C  *  * 

10  C  *  A  -  WIDTH  OF  WAVEGUIDE  IN  X  DIRECTION  -A/2  <=X<=  A/2.  * 

11  C  *  B  -  WIDTH  OF  WAVEGUIDE  IN  Y  DIRECTION  -B/2  <=Y<*  B/2.  * 

12  C  *  C  -  LENGTH  OF  WAVEGUIDE  IN  Z  DIRECTION.  * 

13  C  *  NUA  -  NUMBER  OF  POINTS  ALONG  X  DIRECTION.  * 

u  C  *  NUB  -  NUMBER  OF  POINTS  ALONG  Y  DIRECTION.  * 

15  C  *  NU  -  TOTAL  NUMBER  OF  U  POINTS.  * 

16  C  *  NV  -  TOTAL  NUMBER  OF  V  POINTS.  * 

17  C  *  MN  -  MAXIMUM  DIMENSION  OF  VECTORS  U  AND  V.  * 
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18  C 

* 

MT  -  MAXIMUM  NUMBER  OF  TRIANGLES. 

* 

19  C 

* 

* 

20  C 

* 

OUTPUTS: 

* 

21  C 

* 

* 

22  C 

* 

U(MN)  -  COORDINATES  OF  EACH  DATA  POINT. 

♦ 

23  C 

* 

V(MN) 

* 

24  C 

* 

N2T(MT,3)  MATRIX  OF  N2T  NUMBERS  CONNECTED  TO  EACH 

* 

25  C 

* 

TRIANGLE. 

* 

26  C 

****************************************************************** 

REAL*4  U(MN) ,V(MN) 
INTEGER *4  N2T(MT,3) 
PI= . 3141593E+01 


C  mm**************************************************************** 

C  *  GENERATE  THE  N2T  COORDINATES.  * 

C  ****************************************************************** 

DUA=A/ (NUA-1) 

DUB=B/ CNUB-1) 

DV=C/(NV-1) 

C  ****************************************************************** 

C  *  SECTION  1  HORIZONTAL  COORDINATE.  * 

C  ****************************************************************** 

K=0 

DO  1  I=0,NUA-2 
K=K+1 

U(K)=-B-A+I*DUA 

1  CONTINUE 

C  ****************************************************************** 

C  *  SECTION  2  HORIZONTAL  COORDINATE.  * 

C  ****************************************************************** 

DO  2  1*0, NUB-2 
K=K+1 

U(K)=-B+I*DUB 

2  CONTINUE 

C  ****************************************************************** 

C  *  SECTION  3  HORIZONTAL  COORDINATE.  * 

C  ****************************************************************** 

DO  3  1=0 ,  NUA-2 
K=K+1 

UOO=I*DUA 

3  CONTINUE 

C  ****************************************************************** 

C  *  SECTION  4  HORIZONTAL  COORDINATE.  * 

C  ****************************************************************** 

DO  4  1=0, NUB-1 
K=K+1 

U(K)=A+I*DUB 

4  CONTINUE 

C  ****************************************************************** 

C  *  LONGITUDINAL  (VERTICAL)  COORDINATE.  * 

C  ****************************************************************** 

K=0 

DO  5  I-O.NV-l 
K=K+1 
V(K)=I*DV 

5  CONTINUE 

C  ****************************************************************** 

C  *  GENERATE  THE  CONNECTION  MATRIX.  * 

C  ****************************************************************** 

76  K-0 
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77 

N*0 

78 

DO  6  1=1 ,NU-1 

79 

DO  7  J=1 ,NV-1 

80 

N=N+1 

81 

K=K+1 

82 

N2T(K,  1)=N 

83 

N2T(K,2)*N+1 

84 

N2T(K,3)=N+NV+1 

85 

K-K+l 

86 

N2T(K,1)=N 

87 

N2T(K,2)=N+NV 

88 

N2T(K,3)=N+NV+1 

89 

7 

CONTINUE 

90 

N=N+1 

91 

6 

CONTINUE 

92 

RETURN 

93 

END 

1 

2  C 

3  C 

4  C 

5  C 

6  C 

7  C 

8  C 

9  C 
io  C 
n  C 

12  C 

13  C 

14  C 

15  C 

16  C 

17  C 

18  C 

19  C 

20  C 

21  C 

22  C 

23  C 

24  C 

25  C 

26  C 

27 

28 

29 

30  C 


SUBROUTINE  CYLGRD(A.C,NU,NV,MN,MT,U,V,N2T) 
****************************************************************** 


*  THIS  SUBROUTINE  GENERATES  THE  UNFOLDED  COORDINATES  OF  A  * 

*  SECTION  OF  RECTANGULAR  WAVEGUIDE.  THESE  COORDINATES  REPRESENT  * 

*  THE  VERTICES  OF  TRIANGLES.  NODE  TO  TRIANGLE  CONNECTION  MATRIX  * 

*  IS  ALSO  GENERATED.  * 

****************************************************************** 

*  INPUTS:  * 

*  * 

*  A  -  WIDTH  OF  WAVEGUIDE  IN  X  DIRECTION.  * 

*  B  -  WIDTH  OF  WAVEGUIDE  IN  Y  DIRECTION.  * 

*  C  -  LENGTH  OF  WAVEGUIDE  IN  Z  DIRECTION.  * 

*  NUA  -  NUMBER  OF  POINTS  ALONG  X  DIRECTION.  * 

*  NUB  -  NUMBER  OF  POINTS  ALONG  Y  DIRECTION.  * 

*  NU  -  TOTAL  NUMBER  OF  U  POINTS.  * 

*  NV  -  TOTAL  NUMBER  OF  V  POINTS.  * 

*  MN  -  MAXIHUM  DIMENSION  OF  VECTORS  U  AND  V.  * 

*  MT  -  MAXIMUM  NUMBER  OF  TRIANGLES.  * 

*  * 

*  OUTPUTS:  * 

*  * 

*  U(MN)  -  COORDINATES  OF  EACH  DATA  POINT.  * 

*  V(MN)  * 

*  N2T(MT,3)  MATRIX  OF  N2T  NUMBERS  CONNECTED  TO  EACH  * 

*  TRIANGLE.  * 


****************************************************************** 
REAL*4  U(MN) ,V(MN) 

INTEGERS  N2T(MT,3) 

TP* . 62831853E+01 

****************************************************************** 


31  C  *  GENERATE  THE  N2T  COORDINATES.  * 

32  C  ****************************************************************** 

33  DU-TP*A/(NU-1) 

34  DV*C/ (NV-1) 

35  C  ****************************************************************** 


36  C  *  SECTION  1  HORIZONTAL  COORDINATE.  * 

37  C  ****************************************************************** 


38  K-0 

39  DO  1  I-O.NU-l 

40  K-K+l 

41  U(K)-I*DU 
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CONTINUE 

****************************************************************** 

*  LONGITUDINAL  (VERTICAL)  COORDINATE.  * 

****************************************************************** 
K=0 

DO  5  1=0 ,NV-1 
K-K+l 
V(K)=I*DV 
CONTINUE 

****************************************************************** 

*  GENERATE  THE  CONNECTION  MATRIX.  * 

****************************************************************** 
K»0 
N-0 

DO  6  1=1 ,NU-1 
DO  7  J-l.NV-l 
N-N+l 

K-K+l 

N2T(K,1)=N 
N2T(K,2)=N+1 
N2T(K,3)=N+NV+1 
K=K+1 

N2T(K,1)-N 
N2T(K,2)=N+NV 
N2T(K,3)=N+NV+1 
CONTINUE 
N=N+1 
CONTINUE 
RETURN 
END 

1  SUBROUTINE  RECDAT(A,B,C,KM,NUA,NUB,NV,NN,MN,U,V,M,N) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  WRITES  OUT  THE  COORDINATE  AND  FUNCTION  DATA  * 

4  C  *  FOR  A  RECTANGULAR  WAVEGUIDE  TO  A  FILE.  * 

5  C  ****************************************************************** 

6  R£AL*4  U(MN),V(MN) 

7  TT=A/(NUA-1) 

8  DV-B/ (NUB-1) 

9  DZ=C/(NV-1) 

10  OPEN (UNIT=1 , FILE* ’ RUVFDF ' ) 

11  WRITE(1,*)  A,B>C,KM,M,N 

12  WRITE(1,*)  NUA , NUB , NV 

13  WRITE(1,*)  NN 

14  C  ****************************************************************** 

15  C  *  SIDE  1.  * 

16  C  ****************************************************************** 

17  Y-B/2.0 

18  VX=0  0 

19  VY=-1 .0 

20  VZ=0.0 

21  K=0 

22  DO  1  I-O.NUA-l 

23  X— A/2.0+I*DX 

24  K-K+l 

25  DO  2  J=0,NV-1 

26  Z-J*DZ 

27  CALL  FZ(A,B,M,N,X,Y,Z,VX,VY,VZ,FZV) 

28  CALL  FX(A,B,M,N,X,Y,Z,VX,VY,VZfFXV) 


42  1 

43  C 

44  C 

45  C 

46 

47 

48 

49 

50  5 

51  C 

52  C 

53  C 

54 

55 

56 

57 

58 

59 

60 
61 
62 

63 

64 

65 

66 

67  7 

68 

69  6 

70 

71 
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WRITE(1,*>  U(K),V(J+1),FXV,FZV 

2  CONTINUE 

1  CONTINUE 

c  ****************************************************************** 

C  *  SIDE  2.  * 

C  ****************************************************************** 

X=A/2 . 0 
VX=-1.0 
VY*0.0 
VZ=0.0 

DO  3  1=1, NUB-1 
Y=B/2.0-I*DY 
K=K+1 

DO  4  J=0,NV-1 
Z=J*DZ 

CALL  FZ(A,B,M,N,X,Y,Z,VX,VY,VZ,FZV) 

CALL  FY(A,B,M,N,X,Y,Z,VX,VY,VZ,FYV) 

WRITEd,*)  U(K),V(J+1),-FYV,FZV 

4  CONTINUE 

3  CONTINUE 

C  ****************************************************************** 

C  *  SIDE  3.  * 

C  ****************************************************************** 

Y—B/2.0 
VX-0.0 
VY-1.0 
VZ=0.0 

DO  5  1=1 .NUA-l 
X=A/2.0-I*DX 
K=K+1 

DO  6  J=0,NV-1 
Z=J*DZ 

CALL  FZ(A.B,M,N,X,Y,Z.VX,VY,VZ,FZV) 

CALL  FX(A,B,M,N,X,Y,Z,VX,VY,VZ,FXV) 

WRITEd,*)  U(K) ,V(J+1) ,-FXV,FZV 

6  CONTINUE 

5  CONTINUE 

C  ****************************************************************** 

C  *  SIDE  4.  * 

C  ****************************************************************** 

X»-A/2 . 0 
VX-1.0 
VY-0.0 
VZ=0.0 

DO  7  1=1, NUB-1 
Y=-B/2.0+I*DY 
K-K+l 

DO  8  J=0,NV-1 
Z=J*DZ 

CALL  FZ(A,B,M,N,X,Y,Z,VX,VY,VZ,FZV) 

CALL  FY(A,B,M,N,X,Y,Z,VX,VY,VZ,FYV) 

WRITEd,*)  U(K)  ,V(J+1)  ,FYV,FZV 
8  CONTINUE 

7  CONTINUE 
CLOSE(l) 

RETURN 
END 

l  SUBROUTINE  CYLDAT(A,C,KM,NU,NV,NN,MN,U,V,N,M) 
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2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  WRITES  OUT  THE  COORDINATE  AND  FUNCTION  DATA  * 

4  C  *  FOR  A  CIRCULAR  WAVEGUIDE  TO  A  FILE.  * 

5  C  ****************************************************************** 

6  REAL*4  U(MN) ,V(MN) 

7  TP= . 628318531E+01 

8  DP-TP/(NU-1) 

9  DZ*C/(NV-1) 

io  OPEN (UNIT- 1 , FILE*  >  CUVFDF  > ) 

n  WRITE(1,*)  A,C,KM,N,M 

12  WRITE(1,*)  NU.NV 

13  WRITE (1,*)  NN 

14  C  ****************************************************************** 

is  C  *  SIDE  1.  * 

16  C  ****************************************************************** 

17  R=»A 

18  K*0 

19  DO  1  I-O.NU-l 
P-I*DP 
K-K+l 

DO  2  J-O.NV-l 
Z«J*DZ 

CALL  KURP(A,N,M,R,P,Z,FPV) 

CALL  KURZ(A,N,M,R,P,Z,FZV) 

WRITE(1,*)  U(K) ,V(J+1) .FPV.FZV 
2  CONTINUE 

1  CONTINUE 

CLOSE(l) 

RETURN 
31  END 

1  SUBROUTINE  KURP(A,N,L,R,P,Z,F) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  COMPUTES  THE  SURFACE  CURRENT  FLOWING  IN  THE  X  * 

4  C  *  DIRECTION.  * 

5  C  ****************************************************************** 

«  CALL  HZTEC(A,N,L,R,P.Z,HZ) 

7  F=*HZ 

8  RETURN 

9  END 

1  SUBROUTINE  KURZ(A,N,L,R,Pf Z,F) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  COMPUTES  THE  SURFACE  CURRENT  FLOWING  IN  THE  X  * 

4  C  *  DIRECTION.  * 

5  C  ****************************************************************** 

6  CALL  HPTEC(A,N,L,R,P,Z,HP) 

7  F— HP 

8  RE1JRN 

9  END 

1  SUBROUTINE  FX(A,B,M,N,X,Y,Z,VX,VY,VZ,F) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  COMPUTES  THE  SURFACE  CURRENT  FLOWING  IN  THE  X  * 

4  C  *  DIRECTION.  * 

5  C  ****************************************************************** 

«  CALL  HZTE(X,Y,Z,A,B,M,N,HZ) 

7  CALL  HYTE(X,Y,Z,A,B,M,N,HY) 

8  F«VY*HZ-VZ*HY 
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9  RETURN 

10  END 

1  SUBROUTINE  FYCA.B.M.N.X.Y.Z.VX.VY.VZ.F) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  COMPUTES  THE  SURFACE  CURRENT  FLOWING  IN  THE  Y  * 

4  C  *  DIRECTION.  * 

5  C  ****************************************************************** 

6  CALL  HXTE(X,Y,Z,A,B,M,N,HX) 

7  CALL  HZTE(X,Y,Z,A,B,M,N,HZ) 

8  F=VZ*HX-VX*HZ 

9  RETURN 

10  END 

1  SUBROUTINE  FZ(A,B,M,N,X,Y,Z,VX,VY,VZ,F) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  COMPUTES  THE  SURFACE  CURRENT  FLOWING  IN  THE  Z  * 

4  C  *  DIRECTION.  * 

s  C  ****************************************************************** 

6  CALL  HYTE(X,Y,Z,A,B,M,N,HY) 

7  CALL  HXTE(X,Y,Z,A,B,M,N,HX) 

8  F-VX*HY-VY*HX 

9  RETURN 

10  END 

1  SUBROUTINE  HXTE(X,Y,Z,A ,B.M,N,HX) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  COMPUTES  THE  X  COMPONENT  OF  THE  MAGNETIC  FIELD  * 

4  C  *  ON  THE  SURFACE  OF  A  RECTANGULAR  WAVEGUIDE  FOR  A  TE  MODE.  * 

5  C  ****************************************************************** 

6  PI* . 3141593E+01 

7  TP2-. 394784 176E+02 

8  ARGX* (M*PI/A) * (X-A/2 . 0) 

9  ARGY* (N*PI/B) * (Y-B/2 . 0) 

10  H2* (M*PI/A) * (M*PI/A) + (N*PI/B) * (N*PI/B) 

11  BETA-SQRT (TP2-H2) 

12  ARGZ— BETA*Z 

13  H2* (M*PI/A) * (M*PI/A) + (N*PI/B) * (N*PI/B) 

14  HX- (-M*PI*BETA/ ( A*H2) ) *SIN (ARGX) *COS (ARGY) *SIN (ARGZ) 

15  RETURN 

16  END 

1  SUBROUTINE  HYTE(X,Y,Z,A,B,M,N,HY) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  COMPUTES  THE  X  COMPONENT  OF  THE  MAGNETIC  7IELD  * 

4  C  *  ON  THE  SURFACE  OF  A  RECTANGULAR  WAVEGUIDE  FOR  A  TE  MODE.  * 

5  C  ****************************************************************** 

6  PI* . 3141593E+01 

7  TP2* . 394784176E+02 

8  ARGX* (M*PI/A) * (X-A/2 . 0) 

9  ARGY- (N*PI/B)* (Y-B/2. 0) 

10  H2* (M*PI/A) * (M*PI/A) ♦ (N*PI/B) * (N*PI/B) 

11  BETA-SQRT (TP2-H2) 

12  ARGZ— BETA*Z 

13  HY- ( -N*PI*BETA/ (B*H2) ) *COS (ARGX) *SIN (ARGY) *SIN (ARGZ) 

14  RETURN 

15  END 

l  SUBROUTINE  HZTE(X,Y,Z,A,B,M,N,HZ) 
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2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  COMPUTES  THE  Z  COMPONENT  OF  THE  MAGNETIC  FIELD  * 

4  C  *  ON  THE  SURFACE  OF  A  RECTANGULAR  WAVEGUIDE  FOR  A  TE  MODE.  * 

s  c  ****************************************************************** 

6  PI-.3141593E+01 

7  TP2- . 394784176E+02 

s  ARGX* (M*PI/A) * (X-A/2 . 0) 

9  ARGY* (N*PI/B) * (Y-B/2 . 0) 

jo  H2* (M*PI/A) *  CM*PI/A) + (N*PI/B) * (N*PI/B) 

u  BETA-SQRT (TP2-H2) 

12  ARGZ— BETA*Z 

13  HZ-COS (ARGX) *COS (ARGY) *COS (ARGZ) 

14  RETURN 

15  END 

1  SUBROUTINE  HPTEC(A,N,L,R,P,Z,HP) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  COMPUTES  THE  PHI  COMPONENT  OF  THE  MAGNETIC  * 

4  C  *  FIELD  ON  THE  SURFACE  OF  A  CIRCULAR  WAVEGUIDE  FOR  A  TE_{NL>  * 

5  C  *  MODE  AT  TIME  T-0.  NOTE  THAT  THE  BESSEL  FUNCTION  IS  NOT  * 

«  C  *  INCLUDED  SINCE  IT  WILL  DROP  OUT  WHEN  THE  CURRENT  IS  NORMALIZED.* 

7  C  ****************************************************************** 

8  REAL  KC 

9  PI* . 3141593E+01 

10  TP2* . 394784176E+02 

11  PNL-ROOT(N.L) 

12  KC-PNL/A 

13  BETA*SQRT  (TP2-KC*i.  J) 

14  ARGZ— BETA*Z 

13  HP* (-N*TP2/ (KC*KC*BETA*R) ) *SIN (N*P) *SIN (ARGZ) 

18  RETURN 

17  END 

1  SUBROUTINE  HZTEC(A.N,L,R,P,Z,HZ) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  COMPUTES  THE  Z  COMPONENT  OF  THE  MAGNETIC  FIELD  * 

4  C  *  ON  THE  SURFACE  OF  A  CIRCULAR  WAVEGUIDE  FOR  A  TE_{NL>  MODE.  * 

5  C  *  NOTE  THAT  THE  BESSEL  FUNCTION  IS  NOT  INCLUDED  SINCE  IT  WILL  * 

0  C  *  DROP  OUT  WHEN  THE  CURRENT  IS  NORMALIZED.  * 

7  C  ****************************************************************** 

8  REAL  KC 

9  PI* . 3141593E+01 

10  TP2* . 394784176E+02 

11  PNL-ROOT(N,L) 

12  KC-PNL/A 

13  BETA-SQRT (TP2-KC*KC) 

14  ARGZ— BETA*Z 

15  HZ-CQS (N*P) *COS (ARGZ) 

16  RETURN 

17  END 

1  FUNCTION  ROOT(N,L) 

2  C  ****************************************************************** 

3  C  *  THIS  FUNCTION  RETURNS  THE  LTH  ROOT  OF  THE  FIRST  * 

4  C  *  DERIVATIVE  OF  A  BESSEL  FUNCTION  OF  ORDER  N.  * 

5  C  ****************************************************************** 

0  REAL *4  PNL(0:2,4) 

7  PNL(0,1)*3.832 

8  PNL(0,2)*7.016 
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9  PNL(0,3)=10.174 

10  PNL(0,4)“13.324 

11  PNL( 1,1) “1.841 

12  PNL(1,2)*5.331 

13  PNL ( 1 , 3) =8 . 536 

14  PNL(i,4)=11.706 

15  PNL(2,1)“3.054 

16  PNL(2,2)*6.706 

17  PNL(2,3)*9.970 

is  PNL (2, 4) “13. 170 

19  ROOT *PNL (N,L) 

20  RETURN 

21  END 

1  SUBROUTINE  TCONEC (MT , N2T , NT , MN , MP , T2N) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  GENERATES  A  MATRIX  WITH  GIVES  ALL  THE  * 

4  C  *  TRIANGLES  CONNECTED  TO  EACH  N2T.  * 

5  Q  ****************************************************************** 


6  C  *  INPUTS:  * 

7  C  *  * 

8  C  *  MT  -  MAXIMUM  NUMBER  OF  TRIANGLES.  * 

9  C  *  N2T(MT,3)  MATRIX  OF  NODE  NUMBERS  CONNECTED  TO  EACH  * 

10  C  *  TRIANGLE.  * 

11  C  *  MN  -  MAXIMUM  NUMBER  OF  NODES.  * 

12  C  *  MP  -  MAXIMUM  NUMBER  OF  POINTS  CONNECTED  TO  EACH  TRIANGLE.  * 

13  C  *  * 

14  C  *  OUTPUT:  * 

15  C  *  * 

16  C  *  T2N(MN,MP)  MATRIX  OF  TRIANGLE  NUMBERS  CONNECTED  TO  EACH  * 

17  C  *  NODE.  * 


18  C  ****************************************************************** 

19  INTEGER*4  N2T(MT,3) ,T2N(MN,MP) 

20  C  ****************************************************************** 

21  C  *  INITIALIZE  THE  MATRIX.  * 

22  C  ****************************************************************** 

23  DO  1  I-l.MN 

24  DO  2  J-l.MP 

25  T2N(I, J)“0 

26  2  CONTINUE 

27  1  CONTINUE 

28  C  ****************************************************************** 

29  C  *  FILL  IN  NON  ZERO  ENTRIES.  * 

30  C  ****************************************************************** 

31  DO  3  1*1, NT 

32  DO  4  J-1,3 

33  IFLAG-0 

34  DO  5  K*1,MP 

35  IF  ((T2N(N2T(I,J),K)  .Eq.  0)  .AND.  (IFLAG  .EQ.  0))  THEN 

36  T2N(N2T(I,J),K)«I 

37  IFLAG* 1 

38  ELSE 

39  END  IF 

40  5  CONTINUE 

41  4  CONTINUE 

42  3  CONTINUE 

43  RETURN 

44  END 


PROGRAM  UNFOLD 

****************************************************************** 

*  THIS  PROGRAM  GENERATES  A  VECTOR  PLOT  OF  A  TRIANGULARIZED  * 

*  UNFOLDED  RECTANGULAR  WAVEGUIDE.  * 

****************************************************************** 

*  TIMOTHY  J.  PETERS  LAST  UPDATED  * 

*  THE  AEROSPACE  CORPORATION  5/12/92  * 

*  2350  EAST  EL  SEGUNDO  BOULEVARD  * 

*  EL  SEGUNDO,  CA  90245  * 

****************************************************************** 
PARAMETER  (MN=6000 ,MT=12000 , MP=6 , NC=5 , NL=6) 

REAL*4  X(MN) ,Y(MN) ,FX(MN) ,FY(MN) ,PHI(50) ,CA(NC) ,CB(NC) 

REAL*8  ARG 
INTEGER  LC(NC) 

CHARACTER* 30  LABEL(NL) 

INTEGERS  N2T(MT,3) ,T2N(MN,MP) 

PI* . 3141593E+01 
TP* . 6283153E+01 
RAD* . 17453293E-01 

****************************************************************** 

*  INPUTS:  * 


*  MN  <*  XIMUM  NUMBER  OF  NODES.  * 

*  MT  -  MAXIMUM  NUMBER  OF  TRIANGLES.  * 

*  IP  -  MAXIMUM  NUMBER  OF  TRIANGLES  CONNECTED  TO  A  NODE.  * 

*  I CEO  -  IGE0=1  (RECTANGULAR)  IGE0=2  (CIRCULAR)  WAVEGUIDE.  * 

*  A  -  SIDE  WIDTH  -A/2  <=X<=A/2  FOR  RECTANGULAR  GUIDE  OR  * 

*  RADIUS  FOR  CIRCULAR  GUIDE  (WAVELENGTHS) .  * 

*  B  -  SIDE  WIDTH  -B/2  <-Y<-B/2  FOR  RECTANGULAR  GUIDE.  * 

*  KM  -  NUMBER  OF  LONGITUDINAL  HALF  CYCLES.  * 

*  NUA  -  NUMBER  OF  POINTS  ALONG  X  DIRECTION.  * 

*  NUB  -  NUMBER  OF  POINTS  ALONG  Y  DIRECTION.  * 

****************************************************************** 
****************************************************************** 

*  READ  THE  COORDINATE  DATA  AND  VECTOR  FUNCTION  DATA  FROM  A  FILE.  * 
****************************************************************** 
IGEO-2 

IF  (IGEO  .EQ.  1)  THEN 

**************************************************************** 

*  RECTANGULAR  WAVEGUIDE.  * 

**************************************************************** 
OPEN (UNIT* 1 , FILE= ’ RUVFDF ’ ) 

READ(1,*)  A,B,C,KM,M,N 
READ(1,*)  NUA, NUB, NV 
READ(1,*)  NN 
VMAX-0.0 
DO  1  I-l.NN 

READ(1,*)  X(I) ,Y(I) ,FX(I) ,FY(I) 
VMAG*SQRT(FX(I)*FX(I)+FY(I)*FY(I)) 

IF  (VMAG  .GT.  VMAX)  THEN 
VMAX-VMAG 
ELSE 
END  IF 
CONTINUE 
CLOSE(l) 

WRITE(*,*)  NN,'  DATA  POINTS  READ  IN’ 

ELSE 

********************************************************,',**4,***,', 

*  CIRCULAR  WAVEGUIDE.  * 
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60  C  **************************************************************** 

61  OPEN (UNIT-1 , FILE- ’ CUVFDF ’ ) 

62  READ(1,*)  A,C,KM,N,M 

63  READ(1,*)  NU.NV 

64  READ(1,*)  NN 

65  VMAX=0.0 

66  DO  2  1=1, NN 

67  READ(1,*)  X(I),Y(I),FX(I),FY(I) 

68  VMAG=SqRT(FX(I)*FX(I)+FY(I)*FY(I)) 

69  IF  (VMAG  .GT.  VMAX)  THEN 

70  VMAX=VMAG 

71  ELSE 

72  END  IF 

73  2  CONTINUE 

74  CLOSE(l) 

75  VRITE(*,*)  NN,’  DATA  POINTS  READ  IN' 

76  END  IF 

77  C  ****************************************************************** 

78  C  *  NORMALIZE  THE  VECTOR  COMPONENTS  SO  THAT  THE  MAXIMUM  MAGNITUDE  * 

79  C  *  IS  1.0.  * 

80  C  ****************************************************************** 

81  DO  3  1=1, NN 

82  FX(I)=FX(I)/VMAX 

83  FY (I)=FY (I) /VMAX 

84  3  CONTINUE 

85  C  ****************************************************************** 

86  C  *  READ  THE  NODE  TO  TRIANGLE  CONNECTION  MATRIX.  * 

87  C  ****************************************************************** 

88  OPEN (UNIT=1 .FILE” ’ N2TDAT’ ) 

89  READd,*)  NT 

90  DO  4  1=1, NT 

91  READ(1,*)  N2T(I,1) ,N2T(I,2) ,N2T(I,3) 

92  4  CONTINUE 

93  CLOSE(l) 

94  WRITE<*,*)  ’NODE  TO  TRIANGLE  DATA  READ  IN’ 

95  C  ****************************************************************** 

96  C  *  READ  THE  TRIANGLE  TO  NODE  CONNECTION  MATRIX.  * 

97  C  ****************************************************************** 

98  OPEN (UNIT-1 .FILE- ’T2NDAT ’ ) 

99  READ(1,*)  NN 

100  DO  5  1=1, NN 

101  READC1,*)  (T2N(I, J) , J-l.MP) 

102  5  CONTINUE 

103  CLOSE(l) 

104  WRITE(*,*)  ’TRIANGLE  TO  NODE  DATA  READ  IN’ 

105  C  ****************************************************************** 

106  C  *  COMPUTE  THE  CENTER  OF  THE  PLOT  REGION.  * 

107  C  ****************************************************************** 

108  IF  (IGEO  .EQ.  1)  THEN 

109  XMIN— B-A 

no  XMAX-A+B 

111  ELSE 

112  XMIN-0.0 

113  XMAX=TP*A 

114  END  IF 

115  YMIN-0.0 

lie  YMAX-C 

117  XC- (XMIN+XMAX) /2 . 0 

118  YC=(YMIN+YMAX)/2.0 


42 


119  C  ****************************************************************** 

120  C  *  COMPUTE  THE  CENTER  OF  THE  PRINTING  DEVICE  PAGE.  * 

121  C  ****************************************************************** 

122  X0=72*8. 5/2.0 

123  Y0=72*l 1.0/2. 0+72.0 

124  C  ****************************************************************** 

125  C  *  COMPUTE  THE  SCALE  CONSTANTS.  * 

126  C  ****************************************************************** 

127  GS=150.0 

128  BX=XO-GS*XC 

129  BY=YO-GS*YC 

130  C  ****************************************************************** 

131  C  *  SET  THE  GRAPHIC  BOUNDING  BOX.  * 

132  C  ****************************************************************** 

133  WX* (XMAX-XMIN) 

134  WY-(YMAX-YMIN) 

135  WIDTH=GS*WX 

136  HEIGHT=GS*WY 

137  UA=X0-WIDTH/2 . 0 

138  UB=X0+WIDTH/2 .0+21.0 

139  VA*Y0-HEIGHT/2. 0-53.0 

140  VB=Y0+HEIGHT/2. 0+25.0 

141  C  ****************************************************************** 

142  C  *  COMPUTE  THE  BOUNDING  BOX  FOR  THE  POSTSCRIPT  IN  THE  DEFAULT  * 

143  C  *  COORDINATE  SYSTEM.  * 

144  C  ****************************************************************** 

145  OPEN (UNIT*1 .FILE* ’Waveguide . ps  * ) 

146  REWIND  1 

147  WRITECl ,*)  ’  7. !  PS- Adobe-1 . 0  ’ 

148  WRITECl,*)  ’ '///.Creator :  Timothy  J.  Peters’ 

149  WRITECl ,*)  ’r/.Title:  Unfolded  Waveguide’ 

iso  WRITECl,*)  ’ '/.'/.Creat ionDate :  5-12-92’ 

151  WRITECl, 100)  ’ %%BoundingBox : ’ , INT (UA) , INT (VA) , INT (UB) , INT CVB) 

152  100  F0RMAT(A14,4(1X,I3)) 

153  WRITECl,*)  ’ '/.’/.EndComments ’ 

154  WRITECl,*)  ’/dot2  {2  0  360  arc  0  setgray  fill  stroke}  def’ 

155  WRITECl,*)  ’/dot3  {3  0  360  arc  0  setgray  fill  stroke}  def’ 

156  WRITECl,*)  ’/dot4  -(4  0  360  arc  0  setgray  fill  stroke}  def’ 

157  WRITECl,*)  ’/black  {000  setrgbcolor}  def’ 

158  WRITECl,*)  ’/white  {111  setrgbcolor}  def’ 

159  WRITECl,*)  ’/gray-lt  {0.92  0.92  0.92  setrgbcolor}  def’ 

160  WRITECl,*)  ’/gray-lt-med  {0.65  0.65  0.65  setrgbcolor}  def’ 

161  WRITECl,*)  ’/gray  {0.45  0.45  0.45  setrgbcolor}  def’ 

162  WRITECl,*)  ’ /gray-dk-med  {0.3  0.3  0.3  setrgbcolor}  def’ 

163  WRITECl,*)  ’/gray-dk  {0.14  0.14  0.14  setrgbcolor}  def’ 

164  WRITECl,*)  ’/red  {100  setrgbcolor}  def’ 

165  WRITECl,*)  ’/magenta  {101  setrgbcolor}  def’ 

166  WRITECl,*)  ’/green  {010  setrgbcolor}  def’ 

167  WRITECl,*)  ’/blue  {001  setrgbcolor}  def’ 

168  WRITECl,*)  ’/cyan  {Oil  setrgbcolor}  def’ 

169  WRITECl,*)  ’/yellow  {110  setrgbcolor}  def’ 

170  WRITECl,*)  ’/orange  {1  0.5  0  setrgbcolor}  def’ 

171  WRITECl,*)  ’/brown  {0.5  0.5  0  setrgbcolor}  def’ 

172  WRITECl,*)  ’/kakhi  {0.5  1  0  setrgbcolor}  def’ 

173  WRITECl,*)  ’/blue-lt  {0.5  1  1  setrgbcolor}  def’ 

174  WRITECl,*)  ’/green-lt  {0.5  1  0.5  setrgbcolor}  def’ 

175  WRITECl,*)  ’/green-blue  {0  1  0.5  setrgbcolor}  def’ 

176  WRITECl,*)  ’/purple  {0.6  0  1.0  setrgbcolor}  def’ 

177  WRITECl,*)  ’/filtri  {moveto  lineto  lineto’ 
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178 

179 

180 
181 
182 

183 

184 

185  C 

186  C 

187  C 

188 

189 

190 

191 

192 

193 

194 

195 

196 

197 

198 

199 

200 
201 
202 

203 

204  C 

205  C 

206  C 

207  C 

208 

209 

210 
211 
212 

213  C 

214  C 

215  C 

216  C 

217  C 

218  C 

219  C 

220  C 

221  C 

222 

223 

224 

225 

226 

227 

228 

229 

230 

231 

232 

233 

234 

235 

236 


WRITEd,*) 

WRITEd,*) 

WRITEd,*) 

WRITEd,*) 

WRITEd,*) 

WRITEd,*) 

WRITEd,*) 


’  closepath  fill  stroke}  def’ 

’/filqud  {moveto  lineto  lineto  lineto  closepath  fill* 
’  stroke}  def ’ 

’/filpnt  {moveto  lineto  lineto  lineto’ 

’  lineto  closepath  fill  stroke}  def* 

’•/.‘AEndProlog' 

*1  setlinejoin  .4  setlinewidth’ 


****************************************************************** 


*  ASSIGN  CONTOUR  VALUES  AND  LABELS. 


****************************************************************** 

CA(1)=0.0 

CB(1)=0.15 

CA(2)=0. 15 

CB(2)=0.4 

CA(3)=0.4 

CB(3)=0.6 

CA(4)=0.6 

CB(4)=0.8 

CA(5)=0.8 

CB(5)=1.0 

LABEL(1)=,0> 

LABEL(2)=’.15’ 

LABEL (3)=’ .4’ 

LABEL(4)”’ .6' 

LABEL (5)=’ .8’ 

LABEL (6)=’ 1 ' 

****************************************************************** 

*  ASSIGN  THE  COLORS.  SEE  SUBROUTINE  SETCOL  FOR  COLOR  CHOICES.  * 
****************************************************************** 

GRAY  SCALE 
LCd)=2 
LC(2)=3 
LC<3)=4 
LC(4)=5 
LC(5)=6 
COLOR 

LC(1)»18 

LC(2)=14 

LC(3)«12 

LC(4)=16 

LC(5)=13 

****************************************************************** 

*  DRAW  THE  CONTOUR  PLOT.  * 

****************************************************************** 
WRITEd,*)  ’gsave* 

DO  6  1=1, NT 
N1=N2T(I , 1) 

N2=N2T(I,2) 

N3*N2T(I ,3) 

X1=X(N1) 

Yi»Y(Nl) 

X2=X(N2) 

Y2=Y(N2) 

X3=X(N3) 

Y3*Y(N3) 

U1=TRANS(GS,BX,X1) 

V1»TRANS(GS,BY,Y1) 

U2=TRANS(GS,BX,X2) 

V2»TRANS (GS , BY , Y2) 
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237 

238 

239 

240 

241 

242 

243  6 

244 

245  C 

246  C 

247  C 

248 

249 

250 

251 

252 

253 

254  C 

255  C 

256  C 

257  C 

258  C 

259  C 

260  C 

261  C 

262  C 

263  C 

264  C 

265  C 

266 

267  C 

268  C 

269  C 

270 

271 

272 

273 

274 

275 

276 

277 

278 

279 

280 
281 
282 

283 

284 

285 

286 

287 

288 

289  C 

290  C 

291  C 

292  C 

293  C 

294  C 

295  C 


U3=TRANS (GS , BX , X3) 

V3=TRANS (GS , BY , Y3) 

F1=SQRT (FX(N1) *FX(N1)+FY CN1) *FY (Nl) ) 

F2=SQRT (FX (N2) *FX (N2) +FY (N2) *FY (N2) > 

F3=SQRT(FX(N3)*FX(N3)+FY(N3) *FY(N3) ) 

CALL  CONTUR (U1,V1,U2,V2,U3,V3,F1,F2,F3,CA,CB,NC,LC) 

CONTINUE 

WRITECl,*)  ’grestore’ 

*********** ***** ****** ******* ************ ******* ****************** 

*  DRAW  THE  GRAPH  FRAME.  * 

****************************************************************** 
WRITECl,*)  'gsave  0.5  setlinevidth  0  setgray’ 

WRITECl,*)  TRANS CGS,BX,XMIN) , TRANS CGS, BY, YMIN) , ’  moveto’ 

WRITECl,*)  TRANS CGS, BX, XMAX) , TRANS CGS, BY, YMIN),'  lineto’ 

WRITECl,*)  TRANS (GS,BX,XMAX) , TRANS CGS, BY, YMAX) , ’  lineto’ 

WRITECl,*)  TRANS CGS, BX.XMIN) .TRANS CGS, BY, YMAX) , ’  lineto’ 

WRITECl,*)  ’closepath  stroke  grestore’ 
****************************************************************** 

*  DRAW  THE  EPS  BOUNDING  BOX.  * 

****************************************************************** 

WRITECl,*)  ’gsave  0.2  setlinevidth’ 

WRITECl,*)  UA.VA, ’  moveto’ 

WRITECl,*)  UB.VA, ’  lineto’ 

WRITECl,*)  UB.VB,’  lineto’ 

WRITECl,*)  UA,VB, ’  lineto’ 

WRITECl,*)  ’closepath  stroke  grestore’ 
****************************************************************** 

*  LABEL  EACH  SECTION.  * 

****************************************************************** 
IF  CIGEO  .EQ.  1)  THEN 

**************************************************************** 
*  RECTANGULAR.  * 

**************************************************************** 
CALL  RLABELCXMIN,XMAX,YMIN,YMAX,GS,BX,BY,A,B,KM) 

SL=30 . 0 
SH-15.0 
DDS=0 . 0 
ITYPE=2 

US=TRANS  CGS , BX , XMIN) 

VS=TRANS  CGS , BY ,YMIN) -2 . 5*SH 

CALL  LEGEND CUS , VS ,NC ,NL ,LC , LABEL, SL , SH ,DDS , ITYPE) 

RT.SF. 

KM-5 

CALL  CLABELCXMIN,XMAX,YMIN,YMAX,GS,BX,BY,A,KM) 

SL=30 . 0 
SH=15 . 0 
DDS=0.0 
ITYPE=2 

US-TRANS  CGS , BX , XMIN) 

VS-TRANS  CGS , BY , YMIN) -2.5*SH 

CALL  LEGEND CUS, VS, NC.NL.LC, LABEL, SL,SH,DDS, ITYPE) 

END  IF 

****************************************************************** 

*  IF  REQUESTED  SHOW  THE  TRIANGULAR  GRID.  * 

****************************************************************** 

CALL  PTGRIDCMN,MT,N”\N2T,GS,BX,BY,X,Y) 
****************************************************************** 

*  DRAW  THE  APPROPRIATE  VECTOR  ROUTINE.  * 

****************************************************************** 
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296  BANG=20.0 

297  S=7.0 

298  MNAR*1 

299  DS= .  003 

300  IF  (IGEO  .EQ.  1)  THEN 

301 

302  CALL  RWTE10(MN,MT,MP,NT,N2T,T2N,X,Y,A,B,KM,M,N,XMIN,XMAX 

303  &  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

304  ELSE 

305  CALL  CVTE10(MN,MT,MP,NT,N2T,T2N,X,Y,A,C,KM,N,M,XMIN,XMAX 

306  k  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

307  END  IF 

308  C  ****************************************************************** 

309  C  *  DRAW  THE  PAGE.  * 

310  C  ****************************************************************** 

311  WRITE(1,*)  ’showpage’ 

312  CLOSE(l) 

313  END 

1  SUBROUTINE  PTGRID(MN,MT,NT,N2T,GS,BX,BY,X,Y) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  DRAWS  THE  TRIANGULAR  GRID.  * 

4  C  ****************************************************************** 

5  REAL*4  X(MN),Y(MN) 

6  INTEGER  N2T(MT,3) 

7  C  ****************************************************************** 

8  C  *  LOOP  THROUGH  EACH  TRIANGLE  AND  DRAW  THE  PERIMETER.  * 

9  C  ****************************************************************** 

10  WRITE(1,*)  ’ gsave  o  setgray  0.3  setlinevidth  : 

11  DO  1  1*1, NT 

12  X1-X(N2T(I,1)) 

13  Yl«Y(N2T(I,i>) 

14  X2=X (N2T ( I , 2) ) 

15  Y2*Y (N2T (1,2)) 

16  X3»X(N2T(I,3)) 

17  Y3-Y(N2T(I,3)) 

18  U1=TRANS (GS ,BX ,X1) 

19  V1=TRANS(GS,BY,Y1) 

20  U2-TRANS(GS,BX,X2) 

21  V2*TRANS(GS,BY,Y2) 

22  U3=TRANS(GS,BX,X3) 

23  V3*TRANS(GS,BY,Y3) 

24  CALL  HOVETG(Ul.Vl) 

25  CALL  LINETO (U2,V2) 

CALL  M0VETO(U2,V2) 

27  CALL  LINETO (U3.V3) 

28  CALL  M0VET0(U3,V3) 

29  CALL  LINETO (Ul, VI) 

30  1  CONTINUE 

31  WRITE(1,*)  ’grestore' 

32  RETURN 

33  END 

1  SUBROUTINE  RLABEL(XMIN,XMAX,YMIN,YMAX,CS,BX,BY,A,B,KM) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  DRAWS  THE  LABELS  FOR  THE  RECTANGULAR  GUIDE.  * 

4  C  ****************************************************************** 

5  C  ****************************************************************** 

6  C  *  SECTION  LINES.  * 
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7  C  ****************************************************************** 

8  UD=TRANS(GS,BX,XMIN+A) 

9  VD=TRANS (GS ,BY , YMIN) 

10  WRITEd,*)  UD,VD,’  moveto’ 

11  UD-TRANS(GS,BX,XMIN+A) 

12  VD=TRANS (GS , BY , YHAX) 

13  WRITEd,*)  UD,VD,’  lineto  stroke’ 

14  UD-TRANS (GS , BX , XMIN+A+B) 

15  VD=TRANS(GS,BY,YMIN) 

16  WRITEd,*)  UD,TO,  ’  moveto* 

17  UD=TRANS (GS , BX , XMIN+A+B) 

18  VD=TRANS(GS,BY,YHAX) 

19  WRITEd,*)  UD.TO,’  lineto  stroke’ 

20  UD=TRANS(GS,BX,XMAX-B) 

21  VD=TRANS(GS,BY,YMIN) 

22  WRITEd,*)  UD,VD,  ’  moveto* 

23  UD=TRANS (GS , BX , XMAX-B) 

24  VD=TRANS(GS,BY,YMAX) 

25  WRITE(1,*)  UD,VD,’  lineto  stroke’ 

C  ****************************************************************** 

C  *  SIDE  LABELS.  * 

C  ****************************************************************** 

WRITECl,*)  ’ /Times -Roman  findfont  10  scalefont  setfont’ 

XE=XMIN 
YE=YMAX 

UD=TRANS(GS,BX,XE) 

VD=TRANS (GS , BY , YE) 

WRITECl,*)  UD,VD+6.0,’  moveto’ 

WRITECl,*)  ’(side  1)  show’ 

XE=XMIN+A/2 
YE-YMIN 

DD=TRANS (GS , BX , XE) 

VD=TRANS (GS , BY , YE) 

WRITE(1,*)  UD,VD,’  moveto’ 

WRITE(1,*)  ’/Times-Italic  findfont  10  scalefont  setfont’ 

WRITE(1,*)  ’(y  =  b/2)  stringwidth  pop  neg  2  div  -10  rmoveto’ 
WRITECl,*)  ’(y  *  b)  show’ 

WRITE(1,*)  ’/Times-Roman  findfont  10  scalefont  setfont’ 

WRITE(1,*)  * (/2)  show’ 

XE=XMIN+A/2 . 0 
YE-YMAX 

UD-TRANS (GS , BX , XE) 

VD-TRANS (GS , BY , YE) 

WRITE(1,*)  ’0.4  setlinewidth’ 

A0=10 . 0 

WRITE(1,*)  0D,VD+A0,’  moveto’ 

WRITEd,*)  UD.VD+A0+15.0, ’  lineto  stroke’ 

WRITE(1,*)  UD-3.VD+A0+1B. 0-5.0, ’  moveto’ 

WRITEd,*)  UD.VD+A0+15.0,’  lineto’ 

WRITEd,*)  UD+3.VD+A0+15. 0-5.0, ’  lineto  stroke’ 

WRITEd,*)  UD-11.0.VD+15.0, ’  moveto’ 

WRITEd,*)  ’/Times-Italic  findfont  10  scalefont  setfont’ 

WRITECl,*)  ’(z)  show’ 

XE— B 
YE-YMAX 

UD-TRANS(GS.BX.XE) 

VD-TRANS(GS.BY.YE) 

WRITEd,*)  UD.VD+6.0,’  moveto’ 

WRITECl,*)  ’/Times-Roman  findfont  10  scalefont  setfont’ 
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66  WRITEC1,*)  '(side  2)  show’ 

67  XE=XMIN+A+B/2 

68  YE=YMIN 

69  UD*TRANS(GS,BX,XE) 

to  VD=TRANS(GS,BY,YE) 

71  WRITE(1,*)  UD.VD,’  moveto’ 

72  WRITE(1,*)  ’/Times-Italic  findfont  10  scalefont  setfont’ 

73  WRITE (1,*)  ’(x  =  a/2)  stringwidth  pop  neg  2  div  -10  rmoveto’ 

74  WRITE(1,*)  ’(x  =  a)  show’ 

75  WRITE(1,*)  ’/Times-Roman  findfont  10  scalefont  setfont’ 

76  WRITE(1,*)  ’ (/2)  show’ 

77  XE=0.0 

78  YE=YMAX 

79  UD»TRANS(GS,BX,XE) 

so  VD=TRANS (GS , BY , YE) 

81  WRITEd,*)  UD,VD+6.0,’  moveto’ 

82  WRITEd,*)  ’/Times-Roman  findfont  10  scalefont  setfont’ 

83  WRITE(1,*)  ’(side  3)  show’ 

84  XE=XMIN+A+B+A/2 

85  YE=YMIN 

86  UD=TRANS(GS,BX,XE) 

87  VD=TRANS(GS,BY,YE) 

88  WRITE(1,*)  UD.VD,’  moveto’ 

89  WRITE (1,*)  ’/Times-Italic  findfont  10  scalefont  setfont’ 

90  WRITE(1,*)  ’(y  ■  -b/2)  stringwidth  pop  neg  2  div  -10  rmoveto’ 

91  WRITE(1,*)  ’(y  *  -b)  show’ 

92  WRITE (1,*)  ’/Times-Roman  findfont  10  scalefont  setfont* 

93  WRITE(1,*)  ’ (/2)  show’ 

94  XE=A 

95  YE=YMAX 

96  UD-TRANS(GS,BX,XE) 

97  VD»TRAHS (GS , BY , YE) 

98  WRITE(1,*)  UD.VD+6.0,’  moveto’ 

99  WRITE(1,*)  ’/Times-Roman  findfont  10  scalefont  setfont’ 

100  WRITE(i,*)  ’(side  4)  show’ 

101  XE=XMAX-B/2 

102  YE=YMIN 

103  UD-TRANS(GS.BX.XE) 

104  VD*TRANS (GS , BY , YE) 

105  WRITE(1,*)  UD.VD, ’  moveto’ 

loe  WRITE(1,*)  ’/Times-Italic  findfont  10  scalefont  setfont’ 

107  WRITE(1,*)  ’(x  *  -a/2)  stringwidth  pop  neg  2  div  -10  rmoveto’ 

108  WRITE(1,*)  ’(x  *  -a)  show’ 

109  WRITE(1,*)  ’/Times-Roman  findfont  10  scalefont  setfont' 

no  WRITE(1,*)  ’ (/2)  show’ 

111  C  ****************************************************************** 

112  C  *  Z-AXIS  LABELS.  * 

113  C  ****************************************************************** 

114  TL-7.0 

115  PL-10.0 

116  KT-KM+1 

117  XE-XMAX 

118  UD-TRANS(GS.BX.XE) 

119  DY-(YMAX-YMIN)/ (KT-1) 

120  DO  1  I -0,  KT-1 

121  YE*YMIN+I*DY 

122  VD-TRANS(GS.BY.YE) 

123  WRITE(1,*)  UD.VD,’  moveto' 

124  WRITEd,*)  UD+TL.VD,  ’  lineto  stroke’ 
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125  1 

126 

127 

128 

129 

130 

131 

132 

133 

134 

135 

136 

137 

138 

139 

140 

141 

142 

143 

144 

145 

146 

147 

148 

149 

150 

151 

152 

153 

154 

155 

156 

157 

158 

159 

160 
161 
162 

163 

164 

165 

166 

167 

168 
169 


CONTINUE 

VD*TRANSCGS,BY,YMIN) 
WRITECl,*)  UD+TL+PL.VD , ’ 
WRITECl,*)  UD+TL+PL.VD,’ 


moveto  gsave’ 
translate  90  rotate’ 


WRITE(1,+)  ’/Times-Roman  findfont  10  scalefont  setfont’ 

WRITECl,*)  ’CO)  stringvidth  pop  2  div  neg  0  rmoveto’ 

WRITECl,*)  ’CO)  show’ 

WRITECl,*)  ’grestore’ 

VD=TRANS CGS , BY , YMIN+DY) 

WRITECl,*)  UD+TL+PL.VD, *  moveto  gsave’ 

WRITECl,*)  UD+TL+PL.VD, ’  translate  90  rotate’ 

/Symbol  findfont  10  scalefont  setfont’ 

C\160  \244  \142)  stringwidth  pop  2  div  neg  0  rmoveto’ 
C\160  \244  \142)  show’ 
grestore’ 

BY,YMIN+2*DY) 

moveto  gsave* 
translate  90  rotate’ 

/Symbol  findfont  10  scalefont  setfont’ 

C2X160  \244  \142)  stringwidth  pop  2  div  neg  0  rmoveto’ 
C2\160  \244  \142)  show’ 
grestore  * 

BY,YMIN+3*DY) 

moveto  gsave’ 
translate  90  rotate’ 

/Symbol  findfont  10  scalefont  setfont’ 

C3\160  \244  \142)  stringwidth  pop  2  div  neg  0  rmoveto’ 
C3\160  \244  \142)  show’ 
grestore’ 

BY,YMIN+4*DY) 

moveto  gsave’ 
translate  90  rotate’ 

/Symbol  findfont  10  scalefont  setfont’ 

C4\160  \244  \142)  stringwidth  pop  2  div  neg  0  rmoveto’ 
C4\160  \244  \142)  show’ 
grestore ’ 

BY,YMIN+5*DY) 

moveto  gsave’ 
translate  90  rotate’ 

/Symbol  findfont  10  scalefont  setfont’ 

C5\160  \244  \142)  stringvidth  pop  2  div  neg  0  rmoveto’ 
C5\160  \244  \142)  show’ 
grestore’ 


WRITECl.*) 

WRITECl,*) 

WRITECl,*) 

WRITECl,*) 

VD=TRANSCGS 
WRITECl,*)  UD+TL+PL.VD, ’ 
WRITECl,*)  UD+TL+PL.VD, ’ 
WRITECl,*) 

WRITECl,*) 

WRITECl.*) 

WRITECl,*) 

VD=TRANSCGS 
WRITECl,*)  UD+TL+PL.VD, ’ 
WRITECl,*)  UD+TL+PL.VD,’ 
WRITECl,*) 

WRITECl,*) 

WRITECl,*) 

WRITECl,*) 

VD=TRANSCCS 
WRITECl,*)  UD+TL+PL.VD, ’ 
WRITECl,*)  UD+TL+PL.VD, ’ 
WRITECl.*) 

WRITECl,*) 

WRITECl,*) 

WRITECl,*) 

VD=TRANSCGS 
WRITECl,*)  UD+TL+PL.VD, ’ 
WRITECl,*)  UD+TL+PL.VD,’ 
WRITECl,*) 

WRITECl,*) 

WRITECl,*) 

WRITECl,*) 

RETURN 
END 


1  SUBROUTINE  CLABELCXMIN,XMAX,YMIN,YMAX,GS,BX,BY,A,KM) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  DRAWS  THE  LABELS  FOR  THE  CIRCULAR  GUIDE.  * 

4  C  ****************************************************************** 

5  C  ****************************************************************** 

6  C  *  Z-AXIS  LABELS.  * 

7  C  ****************************************************************** 

8  XE-XMIN 

9  YE-YMAX 

10  UD-TRANSCGS.BX.XE) 

11  VD-TRANSCGS.BY.YE) 

12  WRITECl,*)  ’0.4  setlinevidth’ 

13  A0-10.0 
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14  WRITEC1,*)  UD.VD+AO, ’  moveto’ 

15  WRITEC1,*)  UD.VD+A0+15.0, ’  lineto  stroke’ 

i«  WRITEC1,*)  UD-3.VD+A0+15. 0-5.0,’  moveto’ 

17  WRITEd,*)  UD.VD+A0+15.0,  ’  lineto’ 

is  WRITE(1,*)  UD+3.VD+A0+ 15. 0-5.0, ’  lineto  stroke’ 

19  WRITEd,*)  UD+11.0,VD+15.0,  ’  moveto’ 

WRITE(1,*)  ’/Times-Italic  findfont  10  scalefont  setfont’ 

WRITEd,*)  ’(z)  stow’ 

TL-7.0 
PL-10 . 0 
KT=KM+1 
XE-XMAX 

UD=TRANS (GS , BX , XE) 

DY- (YMAX-YMIN) / (KT-1) 

DO  1  1=0, KT-1 
YE=YMIN+I*DY 
VD=TRANS (GS , BY , YE) 

WRITE(1,*)  UD.VD, ’  moveto’ 

WRITEd,*)  UD+TL.VD, ’  lineto  stroke’ 

1  CONTINUE 

VD=TRANS (GS ,BY , YMIN) 

WRITEd,*)  UD+TL+PL.VD,  ’  moveto  gsave’ 

WRITE(1,*)  UD+TL+PL,VD, ’  translate  90  rotate’ 

WRITEd,*)  ’/Times-Roman  findfont  10  scalefont  setfont’ 

WRITE(1,*)  ’(0)  stringvidth  pop  2  div  neg  0  rmoveto’ 

WRITEd,*)  ’(0)  show’ 

WRITEd,*)  ’grestore’ 

VD=TRANS(GS ,BY, YMIN+DY) 

WRITECl,*)  UD+TL+PL,VD,’  moveto  gsave* 

WRITEd,*)  UD+TL+PL.VD, ’  translate  90  rotate’ 

WRITEd,*)  ’/Symbol  findfont  10  scalefont  setfont’ 

WRITECl,*)  ’ (\160  \244  \142)  stringvidth  pop  2  div  neg  0  rmoveto’ 
WRITEd,*)  ’ (\160  \244  \142)  show’ 

WRITECl,*)  ’grestore’ 

VD-TRANS (GS , BY , YMIN+2*DY) 

WRITECl,*)  UD+TL+PL.VD, ’  moveto  gsave* 

WRITECl,*)  UD+TL+PL.VD, ’  translate  90  rotate* 

WRITECl,*)  ’/Symbol  findfont  10  scalefont  setfont’ 

WRITECl,*)  *(2\160  \244  \142)  stringvidth  pop  2  div  neg  0  rmoveto’ 
WRITECl,*)  ’ (2\160  \244  \142)  show’ 

WRITECl,*)  ’grestore’ 

VD-TRANS (GS , BY , YMIN+3*DY) 

WRITECl,*)  UD+TL+PL,VD, ’  moveto  gsave’ 

WRITECl,*)  UD+TL+PL,VD, ’  translate  90  rotate’ 

WRITECl,*)  ’/Symbol  findfont  10  scalefont  setfont’ 

WRITECl,*)  ’(3\160  \244  \142)  stringvidth  pop  2  div  neg  0  rmoveto* 
WRITECl,*)  ’ (3\160  \244  \142)  show’ 

WRITECl,*)  ’grestore’ 

VD-TRANS (GS , BY , YMIN+4*DY) 

WRITECl,*)  UD+TL+PL,VD, ’  moveto  gsave’ 

WRITECl,*)  UD+TL+PL,VD, *  translate  90  rotate* 

WRITECl,*)  ’/Symbol  findfont  10  scalefont  setfont’ 

WRITECl,*)  *(4\160  \244  \142)  stringvidth  pop  2  div  neg  0  rmoveto' 
WRITECl,*)  ’ (4\160  \244  \142)  show’ 

WRITECl,*)  ’grestore’ 

VD-TRANS (GS ,BY ,YMIN+5*DY) 

WRITECl,*)  UD+TL+PL,VD, ’  moveto  gsave’ 

WRITECl,*)  UD+TL+PL.VD, ’  translate  90  rotate’ 

WRITECl,*)  ’/Symbol  findfont  10  scalefont  setfont’ 
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73  WRITECl ,*) 1 2 3 4  5 6 7 8 9 10 (5\160  \244  \142)  stringwidth  pop  2  div  neg  0  rmoveto5 

74  WRITECl,*)  * (5\160  \244  \142)  show5 

75  WRITECl,*)  ’grestore5 

76  C  ***********************************************************4****** 

77  C  *  PHI-AXIS  LABELS.  * 

78  C  ****************************************************************** 

79  YE=YMIN 

so  VD=TRANS  CCS , BY , YE) 

81  NPT*5 

82  DX=  CXMAX-XMIN) / CNPT-1 ) 

83  DO  2  I-O.NPT-l 

84  XE=XMIN+I*DX 

85  UD=TRANSCGS,BX,XE) 

86  WRITECl,*)  UD.VD, 5  moveto5 

87  WRITECl,*)  UD.VD-TL, 5  lineto  stroke5 

88  2  CONTINUE 

89  UD-TRANSCGS,BX,XHIN) 

90  WRITECl,*)  UD.VD-TL-PL, 5  moveto5 

91  WRITECl,*)  ’/Symbol  findfont  10  scalefont  setfont5 

92  WRITECl,*)  5 CO)  stringwidth  pop  2  div  neg  0  rmoveto5 

93  WRITECl,*)  5 CO)  show5 

94  WRITECl,*)  5 C\260)  show5 

95  UD*TRANS  CGS , BX , XMIN+DX) 

96  WRITECl,*)  UD,VD-TL-PL, 5  moveto5 

97  WRITECl,*)  ’/Symbol  findfont  10  scalefont  setfont5 

98  WRITECl.*)  5 C90)  stringwidth  pop  2  div  neg  0  rmoveto5 

99  WRITECl,*)  5 C90)  show5 

100  WRITECl,*)  5 C\260)  show5 

101  UD-TRANSCGS ,BX ,XMIN+2*DX) 

102  WRITECl,*)  UD,VD-TL-PL, 5  moveto5 

103  WRITECl,*)  ’/Symbol  findfont  10  scalefont  setfont5 

104  WRITECl,*)  5 C180)  stringwidth  pop  2  div  neg  0  rmoveto5 

105  WRITECl,*)  5 C180)  show5 

106  WRITECl,*)  5  C\260)  show5 

107  UD*TRANS  CGS , BX , XMIN+3*DX) 

108  WRITECl,*)  UD.VD-TL-PL, 5  moveto5 

109  WRITECl,*)  ’/Symbol  findfont  10  scalefont  setfont5 

no  WRITECl,*)  5 C270)  stringwidth  pop  2  div  neg  0  rmoveto5 

111  WRITECl,*)  5 C270)  show5 

112  WRITECl,*)  5 C\260)  show5 

113  UD-TRANSCGS,BX,XMIN+4*DX) 

114  WRITECl,*)  UD.VD-TL-PL,5  moveto5 

H5  WRITECl,*)  ’/Symbol  findfont  10  scalefont  setfont5 

H6  WRITECl,*)  5 C360)  stringwidth  pop  2  div  neg  0  rmoveto5 

117  WRITECl,*)  5 C360)  show5 

ns  WRITECl,*)  5 C\260)  show5 

119  RETURN 

120  END 

1  SUBROUTINE  RWTE10CMN,MT,MP,NT,N2T,T2N,X,Y,A,B,KM,M,N,XMIN,XMAX 

2  *  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

3  C  ****************************************************************** 

4  C  *  THIS  SUBROUTINE  DRAWS  VECTOR  LINES  FOR  A  RECTANGULAR  * 

6  C  *  WAVEGUIDE  WITH  TE10  MODE  FIELDS.  * 

6  C  ****************************************************************** 

7  C  *  INPUTS:  * 

8  C  *  * 

9  C  *  MN  -  MAXIMUM  NUMBER  OF  COORDINATE  POINTS.  * 

10  C  *  KT  -  MAXIMUM  NUMBER  OF  TRIANGLES.  * 
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n  C 

12  C 

13  C 

14  C 

15  C 

16  C 

17  C 

18  C 

19  C 

20  C 

21  C 

22  C 

23  C 

24  C 

25  C 

26  C 
C 
C 
C 
C 

c 


c 

c 

c 

c 

c 

c 


c 

c 

c 

c 

c 

c 

c 


*  N2T(MT,3)  -  NODE  MATRIX  WHERE  FIRST  INDEX  REPRESENTS  * 

*  EACH  TRIANGLE  AND  SECOND  INDEX  REPRESENTS  * 

*  THE  NODE  NUMBERS.  * 

*  T2N(MN,MP)  -  MATRIX  OF  TRIANGLE  TO  NODE  CONNECTIONS  * 

*  WHERE  THE  FIRST  INDEX  IS  THE  NODE  NUMBER  * 

*  AND  THE  SECOND  IS  THE  LOCAL  TRIANGLE  NUMBER.  * 

*  X(MN)  -  COORDINATE  VECTORS  OF  GRID.  * 

*  Y(MN)  * 

*  FX(MN)  -  VECTOR  FUNCTION  FIELD  VALUES  AT  EACH  COORDINATE.  * 

*  FY(MN)  * 

*  AX,BX  -  GRAPHICAL  SCALE  CONSTANTS.  * 

*  AY, BY  * 

*  VL  -  SPACING  BETWEEN  ARROWHEADS  IN  REAL  COORDINATES.  * 

*  BANG  -  ARROW  APEX  HALF  ANGLE  IN  DEGREES.  * 

*  S  -  ARROW  HEAD  SIDE  LENGTH  IN  POINT  SIZE.  * 

*  MNAR  -  MAXIMUM  NUMBER  OF  ARROWS  ALLOWED.  * 

*  DS  -  STEP  SIZE.  * 

*  * 

*  OUTPUTS:  * 

*  * 


****************************************************************** 
REAL *4  X(MN) , Y(MN) ,FX(MN) ,FY(MN) ,KC2 
INTEGER  N2T(MT,3) ,T2N(MN,MP) 

PI* . 3141593E+01 
RAD** . 17453293E-01 

KC2- (M*PI/A) * (M*PI/A) + (N*PI/B) * (N*PI/B) 

BETA»SQRT(4*PI*PI-KC2) 

****************************************************************** 

*  SET  GLOBAL  VECTOR  INPUTS.  * 

****************************************************************** 
AH«S*COS(RAD*BANG) 

****************************************************************** 

*  SET  SPACING  PARAMETERS  BASED  ON  CRITICAL  POINT  LOCATIONS.  * 

****************************************************************** 
TAUY-0.7 

NPY-5 

NPX-9 

TAUX-0.96 

DL-PI/BETA 

DX»TAUX*A/(NPX-1) 

DY«(TAUY*DL) / (NPY-1) 

****************************************************************** 

*  SIDE  1  (Y-B/2).  * 

****************************************************************** 
****************************************************************** 

*  DRAW  VECTOR  LINES  ALONG  A  VERTICAL  LINE  WHICH  ORIGINATE  ON  * 

*  THE  PERIMETER  OF  SIDE  1  AND  TERMINATE  AT  CRITICAL  POINT  1.  * 

****************************************************************** 
K-0 

DO  1  1-1, (NPY-1) /2 
K-K+l 

WRITER, *)  ’DRAWING  VECTOR  ’ ,K 

YE»I*DY 

XE— B 

CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

NDIR-0 

VL-20.0/GS 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,KP 1NT,N2T,T2N ,X,Y,XMIN,XMAX 
A  , YMIN, YMAX,FX,FY,GS,BX, BY, VL, BANG, S, MNAR, DS) 
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70 

71 

72 

73 

74 

75 

76  1 

77  C 

78  C 

79  C 

80  C 

81 
82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97  3 

98  2 

99  C 

100  C 

101  C 

102  C 

103 

104 

105 

106 

107 

108 

109 

110 
111 
112 

113 

114 

115 

116 

117 

118 

119 

120 
121 
122 

123 

124 

125  5 

126  4 

127  C 

128  C 


NDIR-0 

XE=-B-A 

VL-20.0/GS 

CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT1MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

CONTINUE 

****************************************************************** 

*  DRAW  VECTOR  LINES  ALONG  A  HORIZONTAL  LINE  WHICH  ORIGINATE  ON  * 

*  CRITICAL  POINT  2  AND  TERMINATE  ON  CRITICAL  POINT  1.  * 

****************************************************************** 
DXOFF- ( 1 . O-TAUX) *A/2 

DO  2  1=0 ,KM-1 
YE-0.5*DL+I*DL 
DO  3  J=0,NPX-1 
K-K+l 

WRITE(* ,*)  ’DRAWING  VECTOR  ’,K 
XE*-B-A+DXOFF+J*DX 

CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

NDIR-0 

VL-27.0/GS 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

NDIR-1 

VL-27 . O/GS-AH/GS 

CALL  VEC2D (XE,YE,ID,NDIR,MN,MT,MP,NT, N2T , T2N , X , Y , XMIN , XMAX 
k  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

CONTINUE 
CONTINUE 

****************************************************************** 

*  DRAW  VECTOR  LINES  ALONG  A  VERTICAL  LINE  WHICH  ORIGINATE  AT  * 

*  CRITICAL  POINT  2  AND  TERMINATE  ON  THE  PERIMETER  OF  SIDE  1.  * 

****************************************************************** 
DO  4  I-O.KM-2 

YCE- ( 1 . O-TAUY) *0 . 5*DL+0 . 5*DL+I*DL 
IS-(-l)**I 
IF  (IS  >  0)  THEN 
NDIR-1 

VL-20 . O/GS-S/GS 
ELSE 
NDIR-0 
VL-20. O/GS 
END  IF 

DO  5  J-O.NPY-l 
K-K+l 

WRITEC*,*)  ’DRAWING  VECTOR  ’,K 

YE-YCE+J*DY 

XE— B 

CALL  FNDTRI(XE,YE>MN,X,Y,MT,NT,N2T,ID) 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

XE— B-A 

CALL  FNDTRICXE, YE.MN.X, Y,MT,NT,N2T,ID) 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT>MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  .YMIN.YMAX.FX.FY.GS.BX.BY.VL.BANG.S.MNAR.DS) 

CONTINUE 
CONTINUE 

****************************************************************** 

*  DRAW  VECTOR  LINES  ALONG  A  VERTICAL  LINE  WHICH  ORIGINATE  AT  * 
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129  C 

130  C 

131 

132 

133 

134 

135 

136 

137 

138 

139 

140 

141 

142 

143 

144 

145 

146 

147 

148  6 

149  C 

150  C 

151  C 

152  C 

153  C 

154  C 

155  C 

156 

157 

158 

159 

160 
161 
162 

163 

164 

165 

166 

167 

168 

169 

170 

171 

172  7 

173  C 

174  C 

175  C 

176  C 

177 

178 

179 

180 
181 
183 

183 

184 

185 

186 
187 


*  CRITICAL  POINT  5  AND  TERMINATE  ON  THE  PERIMETER  OF  SIDE  1.  * 

****************************************************************** 
NP=(NPY-l)/2 

DO  6  I*0,NP-1 
K=K+1 

WRITEC*,*)  'DRAWING  VECTOR  ’ ,K 
YE-4 . 5*DL+(1. O-TAUY) *0 . 5*DL+I*DY 
XE=-B 

CALL  FNDTRI CXE,YE,MN,X,Y,MT, NT, N2T, ID) 

NDIR-1 

VL=27 . O/GS-AH/GS 

CALL  VEC2DCXE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
*  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

NDIR*1 

VL*27 . O/GS-AH/GS 
XE=-B-A 

CALL  FNDTRI CXE,YE,MN,X,Y,MT,NT,N2T,ID) 

CALL  VEC2D(XE,YE, ID ,NDIR,MN,MT,MP ,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

CONTINUE 

****************************************************************** 

*  SIDE  3  (Y— B/2)  .  * 

****************************************************************** 
****************************************************************** 

*  DRAW  VECTOR  LINES  ALONG  A  VERTICAL  LINE  WHICH  ORIGINATE  ON  * 

*  THE  PERIMETER  OF  SIDE  1  AND  TERMINATE  AT  CRITICAL  POINT  1.  * 

****************************************************************** 
DO  7  1*1, (NPY-l)/2 

K=K+1 

WRITEC*,*)  'DRAWING  VECTOR  ’ ,K 

YE=I*DY 

XE-0 

CALL  FNDTRI (XE, YE, MN,X,Y,MT,NT, N2T, ID) 

NDIR-1 

VL*20. O/GS-AH/GS 

CALL  VEG2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

NDIR*1 
XE-A 

VL-20. O/GS-AH/GS 

CALL  FNDTRI (XE.YE.MN.X.Y.MT, NT, N2T,ID) 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

CONTINUE 

****************************************************************** 

*  DRAW  VECTOR  LINES  ALONG  A  HORIZONTAL  LINE  WHICH  ORIGINATE  ON  * 

*  CRITICAL  POINT  2  AND  TERMINATE  ON  CRITICAL  POINT  1.  * 

****************************************************************** 
DXQFF»(1 .O-TAUX) *A/2 

DO  8  1*0, KM- 1 
YE*0 . 5*DL+I*DL 
DO  9  J-O.NPX-l 
K-K+l 

WRITEC*,*)  'DRAWING  VECTOR  ' ,K 
XE*DXOFF+J*DX 

CALL  FNDTRI CXE,YE,MN,X,Y,MT,NT,N2T, ID) 

NDIR-0 

VL-27.0/GS 

CALL  VEC2D  CXE , YE , ID , NDIR , MN , MT , MP , NT , N2T , T2N , X , Y , XMIN ,  XMAX 
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188 

189 

190 

191 

192 

193  9 

194  8 

195  C 

196  C 

197  C 

198  C 

199 

200 
201 
202 

203 

204 

205 

206 

207 

208 

209 

210 
211 
212 

213 

214 

215 

216 

217 

218 

219 

220 

221  11 
222  10 

223  C 

224  C 

225  C 

226  C 

227 

228 

229 

230 

231 

232 

233 

234 

235 

236 

237 

238 

239 

240 

241 

242 

243 

244  1  2 

245  C 

246  C 


k  .YMIN.YMAX.FX.FY.GS.BX.BY.VL.BANG.S.MNAR.DS) 

NDIR=1 

VL=27 .0/GS-AH/GS 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  .YMIN.YMAX.FX.FY.GS.BX.BY.VL.BANG.S.MNAR.DS) 

CONTINUE 
CONTINUE 

****************************************************************** 

*  DRAW  VECTOR  LINES  ALONG  A  VERTICAL  LINE  WHICH  ORIGINATE  AT  * 

*  CRITICAL  POINT  2  AND  TERMINATE  ON  THE  PERIMETER  OF  SIDE  1.  * 

****************************************************************** 
DO  10  1=0 ,KM-2 

YCE=(1 . O-TAUY) *0 . 5*DL+0 . 5*DL+I*DL 
IS=(-1)**(I+1) 

IF  (IS  >  0)  THEN 
NDIR=1 

VL=20 . O/GS-S/GS 
ELSE 
NDIR=0 
VL=20 . O/GS 
END  IF 

DO  11  J=0,NPY-1 
K=K+1 

WRITE (*,*)  'DRAWING  VECTOR  ’,K 

YE=YCE+J*DY 

XE=0 

CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YKAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

XE=A 

CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

CONTINUE 
CONTINUE 

****************************************************************** 

*  DRAW  VECTOR  LINES  ALONG  A  VERTICAL  LINE  WHICH  ORIGINATE  AT  * 

*  CRITICAL  POINT  5  AND  TERMINATE  ON  THE  PERIMETER  OF  SIDE  1.  * 

****************************************************************** 
NP=(NPY-l)/2 

DO  12  I-O.NP-l 
K=K+1 

WRITE(*,*)  'DRAWING  VECTOR  ’,K 
YE=4 . 5*DL+ ( 1 . O-TAUY) *0 . 5*DL+I *DY 
XE-O 

CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

NDIR=0 
VL=27 . O/GS 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

NDIR=0 
VL-27.0/GS 
XE=A 

CALL  FNDTRICXE, YE.MN.X, Y,MT,NT,N2T,ID) 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

CONTINUE 

***************************************************************4,** 

■»  SIDE  2  (X=A/2) .  * 
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247  C 

248  C 

249  C 

250  C 

251 

252 

253 

254 

255 

256 

257 

258 

259 

260 
261 
262 

263 

264 

265 

266 

267 

268 

269 

270 

271 

272 

273 

274 

275 

276 

277 

278 

279 

280 
281 
282 

283  13 

284  C 

285  C 

286  C 

287 

288 

289 

290 

291 

292 

293 

294 

295 

296 

297 

298 

299 

300 

301 

302 

303  15 

304  14 
308  C 


****************************************************************** 
****************************************************************** 
*  END  POINT  CONTRIBUTIONS.  * 

****************************************************************** 
XMIN—B 
XMAX=0.0 

XE= (XMIN+XMAX) /2 . 0 
NP=(NPY-l)/2 
DO  13  I-0,NP-1 

YE=4 . 5*DL+ ( 1 . O-TAUY) *0 . 5*DL+I*DY 
K-K+l 

WRITEC*,*)  'DRAWING  VECTOR  ’ ,K 
CALL  FNDTRI (XE,YE,MN,X,Y,MT,NT,N2T,ID) 

NDIR=0 
VL-20. O/GS 

CALL  VEC2D(XE,YE,ID,NDIR,MNtMT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

NDIR-1 

VL-20 . O/GS-S/ GS 

CALL  FNDTRI (XE, YE, MN,X,Y,MT,NT,N2T, ID) 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MTtMP,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

YE*(I+1)*DY 
K-K+l 

WRITEC*,*)  'DRAWING  VECTOR  ’  ,K 
CALL  FNDTRI (XE,YE,MN,X,Y,MT,NT,N2T, ID) 

NDIR-0 
VL-20. O/GS 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

NDIR-1 

VL-20. O/GS-S/GS 

CALL  FNDTRI (XE.YE.MN.X.Y, NT, NT.N2T, ID) 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XHIN,XMAX 
ft  ,YMINtYMAX,FX,FY,GS,BX,BY,VL,BANG,SfMNAR,DS) 


CONTINUE 

****************************************************************** 
*  INTERIOR  CONTRIBUTIONS.  * 

****************************************************************** 
DO  14  I-O.KM-2 

YCE- ( 1 . O-TAUY) *0 . 5*DL+0 . 5*DL+I*DL 
DO  15  J-O.NPY-1 
K-K+l 

WRITEC*,*)  'DRAWING  VECTOR  ’ ,K 

YE-YCE+J+DY 

NDIR-1 

VL-20 . O/GS-S/GS 

CALL  FNDTRI (XE,YE,MN,X,Y,MT, NT, N2T.ID) 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

NDIR-0 
VL-20. O/GS 

CALL  FNDTRI (XE,YE,MN,X,Y,MT,NT,N2T, ID) 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NTtN2T,T2N,X,Y,XMIN,XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

CONTINUE 
CONTINUE 

****************************************************************** 
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306  C 

307  C 

308  C 

309  C 

310  C 

311 

312 

313 

314 

315 

316 

317 

318 

319 

320 

321 

322 

323 

324 

325 

326 

327 

328 

329 

330 

331 

332 

333 

334 

335 

336 

337 

338 

339 

340 

341 

342 

343  16 

344  C 

345  C 

346  C 

347 

348 

349 

350 

351 

352 

353 

354 

355 

356 

357 

358 

359 

360 

361 

362 

363  18 

364  17 


*  SIDE  4  (X— A/2) .  ’ 

I****************************************************************** 

♦I***************************************************************** 

*  END  POINT  CONTRIBUTIONS.  * 

****************************************4************************* 

XMIN-A 

XMAX=A+B 

XE*(XMIN+XMAX) /2.0 
NP=(NPY-l)/2 
DO  16  I-O.NP-l 

YE-4 . 5*DL+(1 . O-TAUY) *~ . 5*DL+I*DY 
K-K+l 

WRITEC*,*)  ’DRAWING  VECTOR  ’,K 
CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

NDIR-0 
VL=20 . O/GS 

CALL  VEC2D (XE , YE , ID , NDIR , MN , MT , MP , NT , N2T , T2N , X , Y , XMIN ,XMAX 
ft  .YMIN.YMAX.FX.FY.GS.BX.BY.VL.BANG.S.MNAR.DS) 

NDIR=1 

VL-20 . O/GS-S/GS 

CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

CALL  VEC2D (XE,YE,ID,NDIR,HN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

YE-(I+1)*DY 
K-K+l 

WRITE(*,*)  ’DRAWING  VECTOR  ’,K 
CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

NDIR-0 
VL-20. O/GS 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T>T2N,X,Y,XMIN,XMAX 
ft  ,YMIN,YKAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

NDIR-1 

VL-20. O/GS-S/GS 

CALL  FNDTRI(XE,YE,MNIX,Y,MT,NT,N2T,ID) 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  .YMIN.YMAX.FX.FY.GS.BX.BY.VL.BANG.S.MNAR.DS) 

CONTINUE 

****************************************************************** 

*  INTERIOR  CONTRIBUTIONS.  * 

****************************************************************** 
DO  17  I-O.KM-2 

YCE-(1. O-TAUY) *0 . 5*DL+0 . 5*DL+I*DL 
DO  18  J-O.NPY-l 
K=K+1 

WRITE(*,*)  ’DRAWING  VECTOR  ’,K 

YE*YCE+J*DY 

NDIR-1 

VL-20. O/GS-S/GS 

CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  .YMIN.YMAX.FX.FY.GS.BX.BY.VL.BANG.S.MNAR.DS) 

NDIR-0 
VL-20. O/GS 

CALL  FNDTRI(XE,YE,MN,X,Y,Nr,NT,N2T,ID) 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

CONTINUE 
CONTINUE 
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365  RETURN 

366  END 


1 

2 

3  C 

4  C 

5  C 

6  C 

7  C 

8  C 

9  C 

10  C 

11  C 

12  C 

13  C 

14  C 

15  C 

16  C 

17  C 

18  C 

19  C 

20  C 

21  C 

22  C 

23  C 

24  C 

25  C 

26  C 

27  C 

28  C 

29  C 

30  C 

31  C 

32  C 

33 

34 

35 

36 

37 

38 

39  C 

40  C 

41  C 

42 

43  C 

44  C 

45  C 

46 

47 

48 

49  C 

50  C 

51  C 

52 

53 

54 
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SUBROUTINE  CWTE10(MN,HT,MP,NT,N2T,T2N,X,Yf A,C,KM,N,M,XMIN,XMAX 
k  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,D3) 

******************************************************  f** ********* 


*  THIS  SUBROUTINE  DRAWS  VECTOR  LINES  FOR  A  CIRCULAR  * 

*  WAVEGUIDE  WITH  TE11  MODE  FIELDS.  * 

****************************************************************** 

*  INPUTS :  * 

*  * 

*  XE.YE  -  FIRST  COORDINATE  OF  VECTOR  LINE.  * 

*  MN  -  MAXIMUM  NUMBER  OF  COORDINATE  POINTS.  * 

*  MT  -  MAXIMUM  NUMBER  OF  TRIANGLES.  * 

*  N2T(MT,3)  -  NODE  MATRIX  WHERE  FIRST  INDEX  REPRESENTS  * 

*  EACH  TRIANGLE  AND  SECOND  INDEX  REPRESENTS  * 

*  THE  NODE  NUMBERS.  * 

*  T2N(MN,MP)  -  MATRIX  OF  TRIANGLE  TO  NODE  CONNECTIONS  * 

*  WHERE  THE  FIRST  INDEX  IS  THE  NODE  NUMBER  * 

*  AND  THE  SECOND  IS  THE  LOCAL  TRIANGLE  NUMBER.  * 

*  X(MN)  -  COORDINATE  VECTORS  OF  GRID.  * 

*  Y(MN)  * 

*  FX(MN)  -  VECTOR  FUNCTION  FIELD  VALUES  AT  EACH  COORDINATE.  * 

*  FY(MN)  * 

*  AX.BX  -  GRAPHICAL  SCALE  CONSTANTS.  * 

*  AY, BY  * 

*  VL  -  SPACING  BETWEEN  ARROWHEADS  IN  REAL  COORDINATES.  * 

*  BANG  -  ARROW  APEX  HALF  ANGLE  IN  DEGREES.  * 

*  S  -  ARROW  HEAD  SIDE  LENGTH  IN  POINT  SIZE.  * 

*  MNAR  -  MAXIMUM  NUMBER  OF  ARROWS  ALLOWED.  * 

*  DS  -  STEP  SIZE.  * 

*  * 

*  OUTPUTS:  * 

*  * 


****************************************************************** 
REALM  X(MN)  ,Y(MN)  ,FX(MN)  ,FY(MN) 

INTEGER  N2T(MT,3),T2N(MN,MP) 

PI* . 3141593E+01 
TP* . 6283185E+01 
RAD* . 17453293E-01 
K=0 

****************************************************************** 

*  SET  GLOBAL  VECTOR  INPUTS.  * 

****************************************************************** 
AH=S*COS (RAD*BANG) 

****************************************************************** 

*  SET  SPACING  PARAMETERS  BASED  ON  CRITICAL  POINT  LOCATIONS.  * 

****************************************************************** 
TAUY-0.9 

NPY=5 

DY* (TAUY*C/KM) / (NPY-1) 

****************************************************************** 

*  LEFT  REGION  HORIZONTAL  LINES.  * 

****************************************************************** 
XE-0.0 

DO  1  1=0, KM 

YMIN—C/  (2*KM)  +1  *C/KM 
YMAX-YMIN+C/KM 
DO  2  J=0, NPY-1 
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57 

58 

59 

60 
61 
62 

63 

64 

65 

66 

67 

68 

69 

70 

71 

72  2 

73  1 

74  C 

75  C 

76  C 

77 

78 

79 

80 
81 
82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98  4 

99  3 

100  C 

101  C 

102  C 

103 

104 

105 

106 

107 

108 

109 

110 
111 
112 

113 

114 

115 


YE=YMIN+(C/KM) * (l . 0-TAUY) /2 . 0+ J*DY 
IF  ((YE  .GT.  DY/2.0)  .AND.  (YE  .LT.  C-DY/2.0))  THEN 
K=K+1 

WRITE(*,*)  ’DRAWING  VECTOR  ’ ,K 
CALL  FNDTRI (XE,YE,MN,X,Y,MT,NT,N2T,ID) 

NDIR=0 
VL=20 . O/GS 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

NDIR=1 

VL=20 . 0/ GS-S/GS 

CALL  VEC2D(XE,YE, ID,NDIR,HN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

ELSE 
END  IF 
CONTINUE 
CONTINUE 

****************************************************************** 

*  LEFT  REGION  VERTICAL  LINES.  * 

********************************************************** ******** 
XWIDTH=PI*A 

TAUX=0 . 90 
NPX=9 

DX=TAUX*XWIDTH/ (NPX-1) 

DO  3  1=0, KM- 1 

YE=C/(2*KM)+I*C/KM 

YMIN=YE-C/(2*KM) 

YMAX=YE+C/(2*KM) 

DO  4  J=0, NPX-1 
K=K+1 

WRITE(*,*)  ’DRAWING  VECTOR  ’,K 

XE=XWIDTH* ( 1 . O-TAUX) /2 . 0+ J*DX 

CALL  FNDTRI(XE,YE,MN,X,Y,MT ,NT,N2T,ID) 

NDIR=0 
VL=20 . O/GS 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

NDIR=1 

VL=20 . O/GS-S/ GS 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT>MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

CONTINUE 
CONTINUE 

****************************************************************** 

*  CENTER  REGION  HORIZONTAL  LINES.  * 

****************************************************************** 
XE=PI*A 

DO  5  1=0, KM 

YMIN— C/ (2*KM)  +I*C/KM 
YMAX=YMIN+C/KM 
DO  6  J=0,NPY-1 

YE=YMIN+ (C/KM) * (1 . O-TAUY) /2 . 0+ J*DY 
IF  ((YE  .GT.  DY/2.0)  .AND.  (YE  .LT.  C-DY/2.0))  THEN 
K=K+1 

WRITE(*,*)  ’DRAWING  VECTOR  ’ ,K 
CALL  FNDTRI (XE,YE,MN,X,Y,MT,NT,N2T,ID) 

NDIR=0 
VL=20 . O/GS 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
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YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 


116 

117 

118 

119 

120 
121 
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123  6 

124  5 
126  C 

126  C 

127  C 

128 

129 

130 

131 

132 

133 

134 

135 

136 

137 

138 

139 

140 

141 

142 

143 

144 

145 

146 

147 

148  8 

149  7 

150  C 

151  C 

152  C 

153 

154 

155 

156 

157 

158 

159 

160 
161 
162 

163 

164 

165 

166 

167 

168 

169 

170 

171 

172 

173  10 

174  9 


ft 

NDIR=1 
VL=20 .0/GS-S/GS 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

ELSE 
END  IF 
CONTINUE 
CONTINUE 

****************************************************************** 

*  RIGHT  REGION  VERTICAL  LINES.  * 

****************************************************************** 
XWIDTH=PI*A 

TAUX=0 . 90 

DX=TAUX*XWIDTH/ (NPX-1) 

DO  7  1=0, KM- 1 

YE=C/(2*KM)+I*C/KM 

YMIN=YE-C/(2*KM) 

YMAX=YE+C/(2*KM) 

DO  8  J*0,NPX-1 
K=K+1 

WRITE(*,*)  ’DRAWING  VECTOR  »,K 
XE=PI*A+XWIDTH* ( 1 . O-TAUX) /2 . 0+ J*DX 
CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

NDIR=0 

VL=20.0/GS 

CALL  VEC2D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y, XMIN, XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

NDIR-1 

VL*20 . 0/GS-S/GS 

CALL  VEC2D (XE , YE , ID , NDIR , MN , MT , MP , NT , N2T , T2N , X , Y , XMIN , XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

CONTINUE 
CONTINUE 

****************************************************************** 

*  RIGHT  REGION  HORIZONTAL  LINES.  * 

****************************************************************** 
XE-TP*A 

DO  9  1*0, KM 

YMIN*-C/ (2*KM) +I*C/KM 
YMAX-YMIN+C/KM 
DO  10  J-O.NPY-l 

YE*YMIN+ CC/KM) * ( 1 . O-TAUY) /2 . 0+ J*DY 
IF  ((YE  .GT.  DY/2.0)  .AND.  (YE  .LT.  C-DY/2.0))  THEN 
K-K+l 

WRITE(*,*)  ’DRAWING  VECTOR  ’,K 
CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

NDIR=0 

VL-20.0/GS 

CALL  VEC2D (XE,YE,ID,NDIR,MN,MT,MP,NT,N2T, T2N , X , Y , XMIN , XMAX 
ft  .YMIN.YMAX.FX.FY.GS.BX.BY.VL.BANG.S.MNAR.DS) 

NDIR-1 

VL*20. O/GS-S/GS 

CALL  VEC2D(XE,YE, ID, NDIR,MN,MT,MP,NT,N2T,T2N,X,Y, XMIN, XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

ELSE 
END  IF 
CONTINUE 
CONTINUE 


60 


175 

176 


RETURN 

END 


1 

2 

3  C 

4  C 

5  C 

6  C 

7  C 

8  C 

9  C 

10  C 

11  c 

12  C 

13  C 

14  C 

15  C 

16  C 

17  C 

18  C 

19  C 

20  C 

21  C 

22  C 

23  C 

24  C 

25  C 

26  C 

27  C 

28  C 

29  C 

30  C 

31  C 

32 

33 

34 

35  C 

36  C 

37  C 

38 

39  C 

40  C 

41  C 

42 

43 

44 

45 

46 
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48  C 

49  C 
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56 


SUBROUTINE  VEC2D(XE,YE,ID>NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XHIN,XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,BX,BY,VL,BANG,S,MNAR,DS) 

****************************************************************** 


*  THIS  SUBROUTINE  DRAWS  A  VECTOR  IN  TWO  DIMENSIONS.  * 

****************************************************************** 

*  INPUTS:  * 

*  * 

*  XE.YE  -  FIRST  COORDINATE  OF  VECTOR  LINE.  * 

*  MN  -  MAXIMUM  NUMBER  OF  COORDINATE  POINTS.  * 

*  MT  -  MAXIMUM  NUMBER  OF  TRIANGLES.  * 

*  N2T(MT,3)  -  NODE  MATRIX  WHERE  FIRST  INDEX  REPRESENTS  * 

*  EACH  TRIANGLE  AND  SECOND  INDEX  REPRESENTS  * 

*  THE  NODE  NUMBERS.  * 

*  T2N(MN,MP)  -  MATRIX  OF  TRIANGLE  TO  NODE  CONNECTIONS  * 

*  WHERE  THE  FIRST  INDEX  IS  THE  NODE  NUMBER  * 

*  AND  THE  SECOND  IS  THE  LOCAL  TRIANGLE  NUMBER.  * 

*  X(MN)  -  COORDINATE  VECTORS  OF  GRID.  * 

*  Y(MN)  * 

*  FX(MN)  -  VECTOR  FUNCTION  FIELD  VALUES  AT  EACH  COORDINATE.  * 

*  FY(MN)  * 

*  AX.BX  -  GRAPHICAL  SCALE  CONSTANTS.  * 

*  AY, BY  * 

*  VL  -  SPACING  BETWEEN  ARROWHEADS  IN  REAL  COORDINATES.  * 

*  BANG  -  ARROW  APEX  HALF  ANGLE  IN  DEGREES.  * 

*  S  -  ARROW  HEAD  SIDE  LENGTH  IN  POINT  SIZE.  * 

*  MNAR  -  MAXIMUM  NUMBER  OF  ARROWS  ALLOWED.  * 

*  DS  -  STEP  SIZE.  * 

*  * 

*  OUTPUTS:  * 

*  * 


****************************************************************** 
REALM  X(MN)  ,Y(MN)  ,FX(MN)  ,FY(MN) 

INTEGER  N2T(MT,3) ,T2N(MN,MP) 

MXSTEP-300 

****************************************************************** 

*  STORE  THE  FIRST  TRIANGLE  NUMBER.  * 

****************************************************************** 
IFIRST-ID 

****************************************************************** 

*  STORE  THE  FIRST  POINT.  * 

****************************************************************** 
XFIRST=XE 

YFIRST-YE 

XAT-TRANS(GS.BX.XE) 

YAT=TRANS (GS , BY , YE) 

WRITE(1 , 100)  XAT.YAT, ’  mo veto* 

****************************************************************** 

*  BEGIN  THE  VECTOR  SEG’*ENTS .  * 

****************************************************************** 
K-0 

VSUM-0.0 

KAR-0 

XA-XE 

YA-YE 

CONTINUE 

K-K+l 
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57  C 

58  C 

59  C 

60  C 

61  C 

62  C 

63 

64 

65 

66 

67 

68 

69 

70 

71 

72  C 

73  C 

74  C 

75  C 

76 

77 

78 

79  C 

80  C 

81 
82 

83 

84 

85  C 

86  C 

87  C 

88 

89  C 

90  C 

91  C 

92 

93 

94 

95 

96 

97  C 

98  C 

99  C 
100 

101  C 

102  C 

103  C 

104 

105 

106 

107  C 

108  C 

109  C 

110 
111 
112 

113  C 

114  C 

115  C 


WRITE (*,*)  ’SEGMENT  NUMBER®  ’ ,K, ’  TRIANGLE  NUMBER®  ’.ID 

****************************************************************** 

*  IF  THIS  IS  NOT  THE  FIRST  LINE  THEN  DETERMINE  WHAT  TRIANGLE  * 

*  THE  DRAWN  LINE  CONNECTS  TO  BY  LOOKING  AT  THE  TWO  NODES  NA  AND  * 

*  NB  FORMING  THE  LAST  INTERSECTION.  * 

****************************************************************** 

IF  (K  .GT.  1)  THEN 

IF  (K  .GT.  MXSTEP)  THEN 

WRITEC*,*)  ’MAX  STEPS  EXCEEDED  ’ 

GO  TO  99 
ELSE 
END  IF 
XA=XF 
YA=YF 

IF  (ID  .Eq.  0)  THEN 

************************************************************** 

*  THERE  IS  NO  NEXT  TRIANGLE  WHICH  MEANS  THE  VECTOR  * 

*  TERMINATES  ON  A  BOUNDARY.  * 

************************************************************** 

WRITE(* ,*)  ’TERMINATE  ON  BOUNDARY  TRIANGLE’ 

GO  TO  99 

ELSE  IF  (ID  .EQ.  IFIRST)  THEN 

WRITE(* ,*)  ’BACK  TO  ORIGINAL  TRIANGLE’ 

GO  TO  99 
ELSE 
END  IF 
ELSE 
END  IF 

****************************************************************** 

*  FIND  THE  VECTOR  FUNCTION  VALUE  AT  THE  POINT  (XA.YA).  * 

****************************************************************** 
CALL  VECCOF(MN,MT,ID,X,Y, XA.YA, N2T,FX,FY,A,B,E,C,D,F) 
****************************************************************** 

*  GET  THE  VECTOR  COMPONENTS  AT  THE  POINT  (XA.YA).  * 

****************************************************************** 

FYA»A*XA+B*YA+E 

FXA=OXA+D*YA+F 
FM-SQRT (FXA*FXA+FYA*FYA) 

FXN-FXA/FM 

FYN-FYA/FM 

****************************************************************** 

*  INCREMENT  OR  DECREMENT  THE  VECTOR  FROM  THE  POINT  (XA.YA).  * 

****************************************************************** 

IF  (NDIR  .EQ.  0)  THEN 

**************************************************************** 

*  INCREMENT.  * 

**************************************************************** 

XF=*XA+DS*FXN 

YF«YA+DS*FYN 

ELSE 

**************************************************************** 

*  DECREMENT.  * 

**************************************************************** 

XF«XA-DS*FXN 

YF-YA-DS*FYN 
END  IF 

****************************************************************** 

*  GET  THE  NEXT  TRIANGLE  NUMBER.  * 

****************************************************************** 
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119  C 

120  C 
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122  C 

123  C 

124  C 

125  C 
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134 

135 
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138  C 

139  C 

140  C 

141 

142 

143 

144 

145 

146  C 

147  C 

148  C 

149 

150 

151 
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157 
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160 

161  C 

162  C 

163  C 
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169  C 
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174 


ID0LD=ID 

CALL  FDSTRI (XF,YF,MN,X,Y,MTfMPtNT,N2T,T2N,ID0LD,ID) 

IF  (ID  .EQ.  IFIRST)  THEN 
XF-XFIRST 
YF=YFIRST 

ELSE  IF  (ID  .EQ.  0)  THEN 

WRITE(*,*)  ’BOUNDARY  NODE’ 

**************************************************************** 

*  ADJUST  THE  POINT  IF  IT  IS  OUTSIDE  THE  BOUNDARY.  * 

**************************************************************** 

IF  (XF  .LT.  XMIN)  THEN 

XF=XMIN 

ELSE  IF  (XF  .GT.  XMAX)  THEN 
XF=XMAX 
ELSE 
END  IF 

IF  (YF  .LT.  YMIN)  THEN 
YF=YMIN 

ELSE  IF  (YF  .GT.  YMAX)  THEN 
YF=YMAX 
FTSF 

END  IF 

**************************************************************** 

*  DRAW  THE  LINE  FROM  (XA.YA)  TO  (XF.YF).  * 

**************************************************************** 

XFT=TRANS (GS ,BX ,XF) 

YFT=TRANS(GS,BY,YF) 

WRITE(l.lOO)  XFT.YFT, ’  lineto’ 

GO  TO  99 
END  IF 

****************************************************************** 

*  ADJUST  THE  POINT  IF  IT  IS  OUTSIDE  THE  BOUNDARY.  * 

****************************************************************** 

IF  (XF  .LT.  XMIN)  THEN 

XF=XMIN 

ELSE  IF  (XF  .GT.  XMAX)  THEN 
XF-XMAX 
ELSE 
END  IF 

IF  (YF  .LT.  YMIN)  THEN 
YF-YMIN 

ELSE  IF  (YF  .GT.  YMAX)  THEN 
YF=YMAX 
ET.fiE 

END  IF 

****************************************************************** 

*  DRAW  THE  LINE  FROM  (XA.YA)  TO  (XF.YF) .  * 

****************************************************************** 

XFT«TRANS(GS,BX,XF) 

YFT-TRANS(GS.BY.YF) 

WRITE (1,100)  XFT.YFT,’  lineto’ 

****************************************************************** 

*  DRAW  ARROW  OR  ARROWS  IF  APPROPRIATE.  * 

****************************************************************** 

DAR-SQRT( (XA-XF) * (XA-XF) +(YA-YF) * (YA-YF) ) 

IF  (DAR  .GT.  0.0)  THEN 
IF  (NDIR  .EQ.  0)  THEN 

CALL  ARRW2D (MNAR.VL, BANG, S ,XA ,YA, XF.YF, FXN ,FYN .VSUM.KAR 
*  , GS , BX , BY) 
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175  ELSE 

176  CALL  ARRW2D(MNAR,VL, BANG, S,XF,YF,XA,YA,FXN,FYN,VSUM, KAR 

m  ft  ,GS,BX,BY) 

178  END  IF 

179  ELSE 

iso  END  IF 

181  C  ****************************************************************** 

182  C  *  STOP  IF  VECTOR  MAGNITUDE  DROPS  BELOW  TOLERANCE.  * 

183  C  ****************************************************************** 

184  IF  (FM  .LT.  .001)  THEN 

185  C  WRITE(*,*)  ’CLOSE  TO  AN  UNKNOWN  CRITICAL  POINT’ 

186  GO  TO  99 

187  ELSE 

188  END  IF 

189  GO  TO  999 

190  C  ****************************************************************** 

191  C  *  STCP.  * 

192  C  ****************************************************************** 

193  99  CONTINUE 

194  WRITE (1,*)  ’stroke’ 

195  100  FORMAT (2 (F6. 2, IX) ,A7) 

196  ID=IFIRST 

197  RETURN 

198  END 


1  SUBROUTINE  ARRW2D(MNAR, VL .BANG ,S,XA,YA,XF, YF.FXN ,FYN ,VSUM,KAR 

2  ft  ,GS,BX,BY) 

3  C  ****************************************************************** 

4  C  *  THIS  SUBROUTINE  CONTROLS  THE  DRAWING  OF  ARROWHEADS  ON  A  LINE.  * 

5  C  ****************************************************************** 

6  C  *  INPUTS:  * 

7  C  *  * 

8  C  *  MNAR  -  MAXIMUM  NUMBER  OF  ARROWS  ALLOWED.  * 

9  C  *  VL  -  SPACING  BETWEEN  ARROWHEADS  IN  REAL  COORDINATES.  * 

10  C  *  BANG  -  ARROW  APEX  HALF  ANGLE  IN  DEGREES.  * 

11  C  *  S  -  ARROW  HEAD  SIDE  LENGTH  IN  POINT  SIZE.  * 

12  C  *  XA.YA  -  BASE  OF  ARROW.  * 

13  C  *  XF.YF  -  TIP  OF  ARROW.  * 

14  C  *  FXN.FYN  -  NORMALIZED  VECTOR  FUNCTION  VALUES.  * 

15  C  *  VSUM  -  ACCUMULATED  LINE  LENGTH.  * 

16  C  *  KAR  -  NUMBER  OF  ARROWS  DRAWN  SO  FAR.  * 

17  C  *  AX.BX  -  GRAPHICAL  SCALE  CONSTANTS.  ♦ 

18  C  *  AY, BY  * 

19  C  ****************************************************************** 

20  D-SQRTC (XA-XF) * (XA-XF) + (YA-YF) * (YA-YF) ) 

21  STEP-VSUM+D 

22  IF  (STEP  .GT.  VL)  THEN 

23  KAR-KAR+1 

24  IF  (KAR  .GT.  MNAR)  THEN 

25  GO  TO  2 

26  ELSE 

27  END  IF 

28  C  **************************************************************** 


29  C  *  THE  NEXT  LINE  SEGMENT  IS  LONGER  THAN  THE  ARROW  SPACING.  * 

30  C  *  SO  AN  ARROW  SHOULD  BE  DRAWN.  * 

31  C  *******************************  ********************************* 

32  RAT« (VL-VSUM) /D 

33  XFW-XA+RAT* (XF-XA) 

34  YFV-YA+RAT* (YF-YA) 
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c 

c 

c 


c 

c 

c 


c 

c 

c 


c 

c 

c 


1 


c 

c 

c 

c 

c 


2 


**************************************************************** 

*  DRAW  THE  ARROW.  * 

**************************************************************** 
XFJ=TRANS(GS,BX,XFW) 

YFJ*TRANS(GS,BY,YFW) 

CALL  AHED2D(BANG,S,XFJ,YFJ,FXN,FYN) 
**************************************************************** 

*  COMPUTE  THE  AMOUNT  LEFT  OVER  AFTER  THE  ARROW  IS  DRAWN.  * 

**************************************************************** 
DLT=SQRT ( (XF-XFW) * (XF-XFW) + (YF-YFW) * (YF-YFW) ) 

IF  (DLT  .LT.  VL)  THEN 

************************************************************** 

*  NO  MORE  ARROWS  ARE  DRAWN  ON  THIS  SEGMENT.  * 

************************************************************** 
VSUM=DLT 

ELSE 

***********************************>•************************** 

*  MORE  THAN  ONE  ARROW  IS  DRAWN  ON  THIS  SEGMENT.  * 

************************************************************** 
NAR-DLT/VL 

DO  1  1*1, NAR 
KAR=KAR+1 

IF  (KAR  .GT.  MNAR)  THEN 
GO  TO  2 
ELSE 
END  IF 

RAT*=(VL-VSUM+I*VL)  /D 
XFW=XA+RAT* (XF-XA) 

YFW-YA+RAT* (YF-YA) 

XFJ-TRANS(GS.BX.XFW) 

YF J-TRANS  <GS , BY , YFW) 

CALL  AHED2D(BANG,S,XFJ,YFJ,FXN,FYN) 

CONTINUE 

VSUM*SQRT ( (XF-XFW) * (XF-XFW) + (YF-YFW) * (YF-YFW) ) 

END  IF 
ELSE 

**************************************************************** 

*  THE  LINE  LENGTH  PLUS  THE  ACCUMULATED  DISTANCE  IS  STILL  LESS  * 

*  THAN  THE  ARROW  SPACING.  NO  ARROW  SHOULD  BE  DRAWN  JUST  * 

*  ACCUMULATE  THE  DISTANCE.  * 

**************************************************************** 
VSUM-VSUM+D 

END  IF 
CONTINUE 
RETURN 
END 


1  SUBROUTINE  AHED2D(BANG,S,X2,Y2,FXN,FYN) 

2  C  ***************************************************************** 

3  C  *  THIS  SUBROUTINE  DRAWS  A  ARROW  FROM  (Xi,Yl)  TO  (X2,Y2). 

4  C  ***************************************************************** 

5  C  *  INPUTS: 

«  C  * 

7  C  *  BANG  -  ARROW  APEX  HALF  ANGLE  IN  DEGREES. 

8  C  *  S  -  ARROWHEAD  SIDE  LENGTH. 

9  C  *  X2.Y2  -  TIP  OF  ARROW. 

10  C  *  FXN.FYN  -  NORMALIZED  VECTOR  FUNCTION  VALUES. 

n  C  ***************************************************************** 

12  RAD* . 17453293E-01 
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13  X1-X2-FXN 

14  Y1-Y2-FYN 

is  D»SQRT( (X2-X1) * (X2-X1) + (Y2-Y1) * (Y2-Y1) ) 

16  A-l.O-S/D 

17  X3»X1+A* (X2-X1) 

18  Y3*Y 1+A* ( Y2-Y 1 ) 

19  c  **********************************************************4******* 

20  C  *  TRANSLATE  THE  ORIGIN  TO  (X2.Y2)  AND  ROTATE  (X3,Y3)  PLUS  AND  * 

21  C  *  MINUS  BANG  DEGREES  TO  GENERATE  THE  VERTICES  OF  THE  ARROW.  * 

C  ****************************************************************** 

X0=X2 
Y0-Y2 
XA-X3-X2 
YA=Y3-Y2 
ARG*RAD*BANG 
CA-COS(ARG) 

SA-SIN(ARG) 

XCA=XA*CA 
XSA-XA*SA 
YCA*YA*CA 
YSA*YA*SA 
X4*X0+XCA-YSA 
Y4-Y0+XSA+YCA 
X5=X0+XCA+YSA 
Y5=Y0-XSA+YCA 
c  X6= (X4+X5) /2 . 0 

c  Y6*(Y4+Y5)/2.0 

C  WRITEd,*)  XI, Yl, *  moveto’ 

C  WRITEd,*)  X6, Y6, ’  lineto  stroke’ 

C  ****************************************************************** 

C  *  TRANSLATE  THE  ORIGIN  TO  (X2.Y2)  AND  ROTATE  (X3,Y3)  PLUS  AND  * 

C  *  MINUS  BANG  DEGREES  TO  GENERATE  THE  VERTICES  OF  THE  ARROW  * 

C  ****************************************************************** 

WRITEd  ,*)  ’  gsave  nevpath  ’ 

WRITEd,*)  X2.Y2, ’  noveto  \X4,Y4,’  lineto  \X5,Y5,’  lineto’ 
WRITEd,*)  ’ closepath  0  setgray  fill  stroke  grestore’ 

RETURN 
END 
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1  PROGRAM  FLDREC 

2  C  ***************************************************<1************** 

3  C  *  THIS  PROGRAM  GENERATES  A  VECTOR  PLOT  OF  THE  TRIANGULARIZED  * 

4  C  *  REGION  OF  A  RECTANGULAR  WAVEGUIDE.  * 

5  C  ****************************************************************** 

6  C  *  TIMOTHY  J.  PETERS  LAST  UPDATED  * 

7  C  *  THE  AEROSPACE  CORPORATION  5/12/92  * 

8  C  *  2350  EAST  EL  SEGUNDO  BOULEVARD  * 

9  C  *  EL  SEGUNDO,  CA  90245  * 

10  C  ****************************************************************** 

11  PARAMETER  (MN-6000 , MT=* 12000 , MP-6 , NC=5 , NL=6) 

12  REAL*4  U(MN) ,V(MN) ,FU(MN) ,FV(MN) ,PHI(50) ,CA(NC) ,CB(NC) 

13  REAL*4  XQ(3),YQ(3),ZQ(3) 

14  REAL*8  ARC 

is  INTEGER  LC(NC) ,ITMIN(4) ,ITMAX(4) ,ISIDE(4) 

16  CHARACTER*30  LABEL (NL) 

17  INTEGER*4  N2T(MT,3) ,T2N(MN,MP) 

18  PI* . 3141593E+01 

19  RAD* . 17453293E-01 

C  ****************************************************************** 


C  *  INPUTS:  * 
C  *  * 
C  *  GS  -  GRAPH  SCALE  CONSTANT.  * 
C  *  PO  -  PHI  OBSERVATION  ANGLE  (DEGREES) .  * 
C  *  TO  -  THETA  OBSERVATION  ANGLE  (DEGREES) .  * 


C  ****************************************************************** 

GS-180.0 
P0-60.0 
T0-60.0 

C  ****************************************************************** 

C  *  read  THE  COORDINATE  DATA  AND  VECTOR  FUNCTION  DATA  FROM  A  FILE.  * 

C  ****************************************************************** 

OPEN (UNIT-1 .FILE-’RUVFDF’ ) 

READ(1,*)  A,B,C,KM,M,N 
READ(1,*)  NUA.NUB.NV 
READ(1,*)  NN 
VMAX-0.0 
DO  1  1*1,  NN 

READ(1,*)  U(I) ,V(I) ,FU(I) ,FV(I) 
VMAG-SQRT(FU(I)*FU(I)+FV(I)*FV(I)) 

IF  (VMAG  .GT.  VMAX)  THEN 
VMAX-VMAG 
ELSE 
END  IF 

1  CONTINUE 
CLOSE(l) 

WRITE (*,*)  NN,’  DATA  POINTS  READ  IN' 

C  ****************************************************************** 

C  *  NORMALIZE  THE  VECTOR  COMPONENTS  SO  THAT  THE  MAXIMUM  MAGNITUDE  * 

C  *  IS  1.0.  * 

C  ****************************************************************** 

DO  2  I-l.NN 
FU(I)-FU(I)/VMAX 
FV(I)-FV(I)/VMAX 

2  CONTINUE 

C  ****************************************************************** 

C  *  READ  THE  TRIANGLE  NODE  DATA.  * 

C  ****************************************************************** 

OPEN (UNIT- 1 , FILE- » N2TDAT 1 ) 
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60  READ(1,*)  NT 

61  DO  3  1=1, NT 

62  READ(1,0  N2T(I,1),N2T(I,2),N2T(I,3) 

63  3  CONTINUE 

64  CLOSE(l) 

65  WRITE(*,*)  ’NODE  TO  TRIANGLE  DATA  READ  IN’ 

66  C  ****************************************************************** 

67  C  *  READ  THE  TRIANGLE  TO  NODE  CONNECTION  DATA.  * 

68  C  ****************************************************************** 

69  OPEN (UNIT= 1 , FILE= ’ T2NDAT ’ ) 

70  READ(1,*)  NN 

71  DO  4  1=1, NN 

72  READ(1,*)  (T2N(I, J) , J=1,MP) 

73  4  CONTINUE 

74  CLOSE(l) 

75  WRITEC*,*)  ’TRIANGLE  TO  NODE  DATA  READ  IN’ 

76  C  ****************************************************************** 

77  C  *  COMPUTE  CENTROID  OF  GRAPH.  * 

78  C  ****************************************************************** 

79  XMIN—B/2.0 

so  XMAX-B/2.0 

81  YMIN=-A/2.0 

82  YMAX=A/2.0 

83  ZMIN=0 . 0 

84  ZMAX=C 

85  XC= (XMIN+XMAX) /2 . 0 

86  YC= (YMIN+YMAX) /2 . 0 

87  ZC= (ZMIN+ZMAX) /2 . 0 

88  C  ****************************************************************** 

89  C  *  CONVERT  THE  OBSERVATION  ANGLES  TO  RADIANS.  * 

go  C  ****************************************************************** 

91  RAD= . 174S3293E-01 

92  PI= . 3141593E+01 

93  PI4=PI/4.0 

94  XD-XC 

95  YD=YC 

96  ZD=ZC 

97  CALL  SCALE(GS,XD,YD,ZD) 

08  C  ****************************************************************** 

99  C  *  CONVERT  THE  OBSERVATION  ANGLES  TO  RADIANS.  * 

100  C  ****************************************************************** 

101  POBS=RAD*PO 

102  TQBS=RAD*TO 

103  C  ****************************************************************** 

104  C  *  COMPUTE  THE  ROTATION  ANGLES  WHICH  YIELD  THE  DESIRED  OBSERVATION* 

105  C  *  ANGLES.  * 

106  C  ****************************************************************** 

107  RP»- P0BS-PI/2.0 

106  RT-TOBS 

109  C  ****************************************************************** 

no  C  *  COMPUTE  THE  CONSTANTS  FOR  THE  ROTATION  MATRIX.  * 

111  C  ****************************************************************** 

112  CALL  RC0EFF(RP,RT,C1,C2,C3,C4,C5) 

113  C  ****************************************************************** 

114  C  *  COMPUTE  THE  CENTER  OF  THE  PRINTING  DEVICE  PAGE.  * 

115  C  ****************************************************************** 

116  X0=72*8. 5/2.0 

117  Y0=72*ll. 0/2.0 

118  C  ****************************************************************** 


68 


119  C  *  SET  THE  GRAPHIC  BOUNDING  BOX.  * 

120  C  ****************************************************************** 

121  WX= (XMAX-XMIN) 

122  WY= (YMAX-YMIN) 

123  WIDTH=GS*WX 

124  HEIGHT*GS*WY 

125  UA=X0-WIDTH/2. 0-60.0 

126  UB=X0+WIDTH/2. 0+100.0 

127  VA=Y0-HEIGHT/2. 0-180.0 

128  VB=Y0+HEIGHT/2. 0+180.0 

129  C  ****************************************************************** 

130  C  *  COMPUTE  THE  BOUNDING  BOX  FOR  THE  POSTSCRIPT  IN  THE  DEFAULT  * 

131  C  *  COORDINATE  SYSTEM.  * 

132  C  ****************************************************************** 

133  OPEN (UNIT=1 , FILE= ’ F oldedRect .  ps  ’ ) 

134  WRITEd,*)  ’ % ! PS-Adobe-1 . 0 * 

135  WRITEd,*)  ’ ‘/.‘/.Creator :  Timothy  J.  Peters’ 

136  WRITEd,*)  ’’///.Title:  Graph’ 

137  WRITE(1,*)  ’ XXCreat ionDate :  5-14-92’ 

138  WRITEd , 100)  ’ XXBoundingBox : ’ ,INT(UA) , INT(VA) ,INT(UB) ,INT(VB) 

139  100  F0RMAT(A14,4(1X,I3)) 

140  WRITEd,*)  ’ XXEndComments ’ 

141  WRITEd,*)  ’/dot2  {2  0  360  arc  0  setgray  fill  stroke}  def’ 

142  WRITEd,*)  ’/dot3  {3  0  360  arc  0  setgray  fill  stroke}  def’ 

143  WRITEd,*)  ’/dot4  {4  0  360  arc  0  setgray  fill  stroke}  def’ 

144  WRITEd,*)  ’/black  {0  0  0  setrgbcolor}  def’ 

145  WRITEd,*)  ’/white  {111  setrgbcolor}  def’ 

146  WRITEd,*)  ’/gray-lt  {0.92  0.92  0.92  setrgbcolor}  def’ 

147  WRITEd,*)  * /gray-lt-med  {0.65  0.65  0.65  setrgbcolor}  def’ 

148  WRITEd,*)  ’/gray  {0.45  0.45  0.45  setrgbcolor}  def’ 

149  WRITE(1,*)  ’ /gray-dk-med  {0.3  0.3  0.3  setrgbcolor}  def’ 

iso  WRITE(1,*)  ’/gray-dk  {0.14  0.14  0.14  setrgbcolor}  def’ 

151  WRITEd,*)  ’/red  {10  0  setrgbcolor}  def’ 

152  WRITE(1,*)  ’/magenta  {101  setrgbcolor}  def’ 

153  WRITEd,*)  ’/green  {0  10  setrgbcolor}  def’ 

154  WRITEd,*)  ’/blue  {0  0  1  setrgbcolor}  def’ 

155  WRITEd,*)  ’/cyan  {Oil  setrgbcolor}  def’ 

156  WRITEd,*)  ’/yellow  {110  setrgbcolor}  def’ 

157  WRITEd,*)  ’/orange  {1  0.5  0  setrgbcolor}  def’ 

158  WRITEd,*)  ’/brown  {0.5  0.5  0  setrgbcolor}  def’ 

159  WRITEd,*)  ’/kakhi  {0.5  1  0  setrgbcolor}  def’ 

160  WRITEd, *)  ’/blue-lt  {0.5  1  1  setrgbcolor}  def’ 

161  WRITEd,*)  ’/green-lt  {0.5  1  0.5  setrgbcolor}  def’ 

182  WRITEd,*)  ’/green-blue  {0  1  0.5  setrgbcolor}  def’ 

163  WRITE(1,*)  ’/purple  {0.6  0  1.0  setrgbcolor}  def’ 

164  WRITEd,*)  ’/filtri  {moveto  lineto  lineto’ 

165  WRITEd,*)  ’  closepath  fill  stroke}  def’ 

166  WRITEd,*)  '/filqud  {moveto  lineto  lineto  lineto  closepath  fill’ 

167  WRITEd,*)  ’  stroke}  def’ 

168  WRITEd,*)  ’/filpnt  {moveto  lineto  lineto  lineto’ 

169  WRITEd,*)  ’  lineto  closepath  fill  stroke}  def’ 

170  WRITEd,*)  ’XZEndProlog’ 

m  WRITEd,*)  ’1  setline  join  .4  setlinewidth’ 

172  C  ****************************************************************** 

173  C  *  DRAW  THE  EPS  BOUNDING  BOX.  * 

174  C  ****************************************************************** 

175  C  WRITEd,*)  ’gsave  0.2  setlinewidth’ 

176  C  WRITEd,*)  UA,VA,’  moveto’ 

177  C  WRITEd,*)  UB.VA,  ’  lineto’ 
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178  C  VRITECl,*)  UB,VB, *  lineto’ 

m  C  WRITE(1 ,*)  UA,VB, ’  lineto’ 

180  C  WRITE (1,*)  ’closepath  stroke  gre store’ 

181  C  ****************************************************************** 

182  C  *  ASSIGN  CONTOUR  VALUES  AND  LABELS.  * 

183  C  ****************************************************************** 

184  CA(1)»0.0 

185  CB(1)=0. 15 

186  CA(2)=0. 15 

187  CB(2)«0.4 

188  CA(3)=0.4 

189  CB(3)=0.6 

190  CA(4)=0.6 

191  CB(4)«0.8 

192  CA(5)*0.8 

193  CB(5)*1 .0 

194  LABEL(1)*’0’ 

195  LABEL(2)*’.15» 

196  LABEL (3)=’ .4’ 

197  LABEL(4)“’ .6’ 

198  LABEL(5)-’.8> 

199  LABEL(6)=’l’ 

200  C  ****************************************************************** 

201  C  *  ASSIGN  THE  COLORS.  SEE  SUBROUTINE  SETCOL  FOR  COLOR  CHOICES.  * 

202  C  ****************************************************************** 

203  C  GRAY  SCALE 

204  LC(l)-2 

205  LC(2)*3 

206  LC(3)*4 

207  LC(4)-5 

208  LC(5)«6 

209  C  COLOR 

210  C  LC(1)=18 

211  C  LC(2)*14 

212  C  LC(3)»12 

213  C  LC(4)-16 

214  C  LCC5J-13 

215  C  ****************************************************************** 

216  C  *  CALCULATE  AND  STORE  * 

217  C  ****************************************************************** 

218  N1MIN»1 

219  N1MAX«N1MIN+2*(NUA-1)*(NV-1)-1 

220  N2MIN-N1MAX+1 

221  N2HAX-N2MIN+2* (NUB-1) *(NV-1)-1 

222  N3MIN=N2MAX+1 

223  N3MAX«N3MIN+2*(NUA-1)*(NV-1)-1 

224  N4MIN-N3MAX+1 

225  N4MAX*N4MIN+2* (NUB-1) *(NV-1)-1 

226  IF  ((PO  .GE.  0.0)  .AND.  (PO  .LE.  90.0))  THEN 

227  C  **************************************************************** 

228  C  *  DRAW  SIDES  IN  ORDER  3,4,2, 1.  * 

229  C  **************************************************************** 

230  ISIDE(1)«3 

231  ISIDE(2)-4 

232  ISIDE(3)=2 

233  ISIDE(4)«1 

234  ITMIN (1) "N3MIN 

235  ITMAX(1)-N3MAX 

236  ITMIN(2)-N4MIN 
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237 

238 

239 

240 

241 

242 

243 

244  C 

245  C 

246  C 

247 

248 

249  C 

250  C 

251  C 

252 

253 

254 

255 

256 

257 

258 

259 

260 
261 

262  C 

263  C 

264  C 

265 

266  C 

267  C 

268  C 

269 

270 

271  7 

272  C 

273  C 

274  C 

275 

276 

277 

278 

279 

280 
281 
282 

283 

284 

285 

286 

287 

288 

289 

290 

291 

292 

293 

294 

295 


ITMAX (2) =N4MAX 
ITMIN (3) =N2MIN 
ITMAX (3) =N2MAX 
ITMIN(4)=N1MIN 
ITMAX (4 ) =N1MAX 
ELSE 
END  IF 

****************************************************************** 
*  STEP  THROUGH  EACH  SIDE  FROM  BACK  TO  FRONT.  * 

****************************************************************** 
DO  6  J=i,4 
WRITE(*,*)  ’SIDE  ’,J 

**************************************************************** 

*  DRAW  THE  CONTOUR  PLOT  FOR  THIS  SIDE.  * 

**************************************************************** 
DO  7  I=ITMIN(J), ITMAX (J) 

N1=N2T(I , 1) 

N2=N2T(I,2) 

N3-N2T(I,3) 

Fl-SqRT(FU(Nl)*FU(Nl)+FV(Nl)*FV(Ni)) 

F2=SQRT (FU(N2) *FU(N2)+FV(N2) *FV(N2) ) 

F3*SQRT (FU(N3) *FU (N3) +FV (N3) *FV (N3) ) 

CALL  MPRPNT(U(N1) ,V<N1) , A,B,XQ(1) , YQ(i) ,ZQ(1)) 

CALL  MPRPNT(U(N2) ,V(N2) ,A,B,XQ(2) ,YQ(2) ,ZQ(2>) 

CALL  MPRPNT(U(N3) ,V(N3) ,A,B,XQ(3) ,YQ(3) ,ZQ(3)) 
************************************************************** 

*  TRANSFORM  THE  3  VERTICES  OF  THE  TRIANGLE.  * 

************************************************************** 
CALL  TRFTRI«q,YQ,Zq,GS,XD,YD,ZD,Cl,C2,C3,C4,C5,X0,Y0) 
************************************************************** 

*  DRAW  THE  CONTOUR.  * 

************************************************************** 
CALL  CONTUR(Xq(l) ,Yq(l) ,xq(2) ,Yq(2) ,xq(3) ,Yq(3) ,F1,F2,F3 

ft  ,CA,CB,NC,LC) 

CONTINUE 

**************************************************************** 

*  DRAW  THE  PERIMETER  AROUND  THE  SIDE.  * 

**************************************************************** 
IF  (ISIDE(J)  -Eq.  1)  THEN 

Ul— A-B 
Vl-0.0 
U2=*-B 
V2-0.0 
U3-- B 
V3-C 
U4-- A-B 
V4-C 

ELSE  IF  (ISIDE(J)  .Eq.  2)  THEN 
Ul— B 
V1=0.0 
U2-0.0 
V2-0.0 
U3-0.0 
V3*C 
U4*-B 
V4*C 

ELSE  IF  (ISIDE(J)  .Eq.  3)  THEN 
Ul-0.0 
Vl-0.0 
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296 

U2-A 

297 

V2-0.0 

298 

U3-A 

299 

V3=C 

300 

U4=0 .0 

301 

V4-C 

302 

ELSE 

303 

Ul-A 

304 

Vl-0.0 

305 

U2-A+B 

306 

V2=0 . 0 

307 

U3-A+B 

308 

V3=C 

309 

U4=A 

310 

V4*C 

311 

END  IF 

312 

CALL  MPRPNT (U1,V1,A,B,X1,Y1,Z1) 

313 

CALL  MPRPNT (U2,V2, A, B,X2,Y2,Z2) 

314 

CALL  MPRPNT (U3,V3, A, B,X3,Y3,Z3) 

315 

CALL  MPRPNT (U4 ,  V4 ,  A ,  B ,  X4 ,  Y4 ,  Z4) 

316 

CALL  TRFPNT (XI ,Y1,Z1,GS,XD,YD,ZD,C1,C2,C3,C4,C  5,X0,Y0) 

317 

CALL  TRFPNT (X2 , Y2 , Z2 , GS , XD , YD , ZD , Cl , C2 , C3 , C4 , C5 ,X0 ,  YO) 

318 

CALL  TRFPNT(X3,Y3,Z3,GS,XD,YD,ZD,C1 ,C2,C3,C4,C5,X0,Y0) 

319 

CALL  TRFPNT(X4,Y4,Z4,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0) 

320 

WRITEd,*)  ’gsave  0  setgray  0.4  setlinewidth  newpath ’ 

321 

WRITEd,*)  XI, Yl,»  moveto  »,X2,Y2,’  lineto* 

322 

WRITEd.*)  X3,Y3, ’  lineto  \X4,Y4,’  lineto’ 

323 

WRITEd,*)  ’closepath  stroke  grestore’ 

324 

C 

**************************************************************** 

325 

C 

*  DRAW  THE  VECTORS  FOR  THIS  SIDE. 

♦ 

326 

C 

**************************************************************** 

327 

BANG-20.0 

328 

S-8.0 

329 

KNAR-1 

330 

DS-.003 

331 

UMIN— A-B 

332 

UMAX-A+B 

333 

VMIN-0.0 

334 

VMAX-5 . O/SQRT (3 . 0) 

335 

WRITEd,*)  ’0  setg.ay ’ 

336 

CALL  RWTE3D(NDIR,MN,MT,MP,NT,N2T,T2N,D,V,A,B, KM, UMIN, UMAX 

337 

*  ,VMIN,VHAX,FU,FV ,GS,XD,YD,ZD,C1 ,C2,C3,C4,C5,X0,Y0,VL,BANG 

338 

*  ,S,MNAR,DS,PO ,ISIDE( J)) 

339 

6 

CONTINUE 

340 

c 

****************************************************************** 

341 

c 

*  DRAW  THE  LEGEND. 

♦ 

342 

C 

****************************************************************** 

343 

SL-15.0 

344 

SH-30.0 

345 

DS-0.0 

346 

ITYPE-1 

347 

US-420.0 

348 

VS-173.0 

349 

CALL  LEGEND (US, VS, NC.NL.LC, LABEL, SL.SH.DS.ITYPE) 

350 

C 

****************************************************************** 

351 

C 

*  DRAW  THE  PAGE. 

* 

352 

C 

***********************************4*4*4**444*4*444*4*4*44**4***41* 

353 

WRITEd,*)  ’shospage* 

354 

CLOSE(l) 
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END 
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4  C 

5  C 

6  C 

7  C 

8  C 

9  C 
io  C 

n  c 

12  C 

13  C 

14  C 

15  C 

16  C 

17  C 

18  C 

19  C 

20  C 

21  C 

22  C 

23  C 

24  C 

25  C 

26  C 

27  C 

28  C 

29  C 

30  C 

31  C 

32 

33 

34 

35 

36 

37  C 

38  C 

39  C 

40 

41 

42 

43 

44 

45 

46 

47 

48  C 

49  C 
5C  C 

51 

52 

53  C 

54  C 

55  C 

56  C 

57 


SUBROUTINE  RWTE3D(NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,A,B,KM,XMIN,XMAX 
fe , YMIN , YMAX ,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL, BANG 
fc,S,MNAR,DS,PO,IS) 

****************************************************************** 
*  THIS  SUBROUTINE  DRAWS  VECTOR  LINES  FOR  THE  TE10  MODE  FIELDS.  * 
****************************************************************** 


*  INPUTS:  * 

*  * 

*  MN  -  MAXIMUM  NUMBER  OF  COORDINATE  POINTS.  * 

*  MT  -  MAXIMUM  NUMBER  OF  TRIANGLES.  * 

*  N2T(MT,3)  •  ,.JDE  MATRIX  WHERE  FIRST  INDEX  REPRESENTS  * 

*  EACH  TRIANGLE  AND  SECOND  INDEX  REPRESENTS  * 

*  THE  NODE  NUMBERS.  * 

*  T2NCMN.MP)  -  MATRIX  OF  TRIANGLE  TO  NODE  CONNECTIONS  * 

*  WHERE  THE  FIRST  INDEX  IS  THE  NODE  NUMBER  * 

*  AND  THE  SECOND  IS  THE  LOCAL  TRIANGLE  NUMBER.  * 

*  X(MN)  -  COORDINATE  VECTORS  OF  GRID.  * 

*  Y(MN)  * 

*  FX(MN)  -  VECTOR  FUNCTION  FIELD  VALUES  AT  EACH  COORDINATE.  * 

*  FY(MN)  * 

*  AX.BX  -  GRAPHICAL  SCALE  CONSTANTS.  * 

*  AY, BY  * 

*  VL  -  SPACING  BETWEEN  ARROWHEADS  IN  REAL  COORDINATES.  * 

*  BANG  -  ARROW  APEX  HALF  ANGLE  IN  DEGREES.  * 

*  S  -  ARROW  HEAD  SIDE  LENGTH  IN  POINT  SIZE.  * 

*  MNAR  -  MAXIMUM  NUMBER  OF  ARROWS  ALLOWED.  * 

*  DS  -  STEP  SIZE.  * 

*  * 

*  OUTPUTS:  * 

*  * 


****************************************************************** 
REAL*4  X(MN) ,Y(MN) ,FX(MN) ,FY(MN) 

INTEGER  N2T(MT,3) ,T2N (MN,MP) 

PI= . 3141593E+01 
RAD-.17453293E-01 
AH=S*COS (RAD*BANG) 

****************************************************************** 
*  SET  SPACING  PARAMETERS  BASED  ON  CRITICAL  POINT  LOCATIONS.  * 

****************************************************************** 
NPY=5 
NPX-9 
TAUX-0.96 
TAUY=0.7 
DL“1 ,0/SQRT(3.0) 

DX«TAUX*A/(NPX-1) 

DY= (TAUY*DL) / (NPY-1) 

IF  (IS  .EQ.  1)  THEN 

**************************************************************** 

*  DRAW  SIDE  1  (Y-B/2)  VECTORS.  * 

**************************************************************** 

XMIN=-A-B 

XMAX—B 

**************************************************************** 

*  DRAW  VECTOR  LINES  ALONG  A  VERTICAL  LINE  WHICH  ORIGINATE  ON  * 

*  THE  PERIMETER  OF  SIDE  1  AND  TERMINATE  AT  CRITICAL  POINT  1.  * 

*******4>******************************************************** 

K**0 
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77  C 

78  C 

79  C 

80  C 

81 
82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 
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96 

97 

98 

99  3 
100  2 

101  C 

102  C 

103  C 

104  C 

105 

106 

107 

108 

109 

110 
111 
112 

113 

114 
US 
116 


DO  1  1=1 ,  (NPY-D/2 
K-K+l 

WRITEC*,*)  'DRAWING  VECTOR  ’ ,K 

YE=I*DY 

XE=-B 

CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

NDIR=0 
VL=20 . O/GS 

CALL  RVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN>XMAX 
k  , YMI N , YMAX ,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL, BANG 

k  , S,MNAR,DS) 

NDIR=0 

XE=-B-A 

VL=20.0/GS 

CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2Tf ID) 

CALL  RVEC3D(XE,YE>ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX>FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG 

k  ,S,MNAR,DS) 

CONTINUE 

**************************************************************** 

*  DRAW  VECTOR  LINES  ALONG  A  HORIZONTAL  LINE  WHICH  ORIGINATE  ON  * 

*  CRITICAL  POINT  2  AND  TERMINATE  ON  CRITICAL  POINT  1.  * 

**************************************************************** 
DXOFF= ( 1 . O-TAUX) *A/2 

DO  2  I=0,KM-1 
YE=0 . 5*DL+I*DL 
DO  3  J*0,NPX-1 
K=K+1 

WRITEC*,*)  'DRAWING  VECTOR  '  ,K 
XE— B-A+DXOFF+J*DX 

CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

NDIR=0 

VL-27.0/GS 

CALL  RVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX,FX,FY,GSfXD,YD,ZD,Cl,C2,C3,C4,C5,X0,Y0,VL,BANG 

k  ,S,MNAR,DS) 

NDIR-1 

VL»27 . O/GS-AH/GS 

CALL  RVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX,FX,FY>GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG 

k  .S.MNAR.DS) 

CONTINUE 

CONTINUE 

*********************************»'-*******************•************ 

*  DRAW  VECTOR  LINES  ALONG  A  VERTICAL  LTNE  WHICH  ORIGINATE  AT  * 

*  CRITICAL  POINT  2  AND  TERMINATE  ON  THE  PERIMETER  OF  SIDE  1.  * 

******************************* *********************************** 
DO  4  1*0, KM- 2 

YCE= (1 . O-TAUY) *0 . 5*DL+0 . 5*DL+I*DL 
IS=(-1)**I 
IF  (IS  >  0)  THEN 
NDIR-1 

VL-20 . O/GS-S/GS 
ELSE 
NDIR-0 
VL-20.0/GS 
END  IF 

DO  5  J-O.NPY-l 
K-K+l 
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131  C 

132  C 

133  C 

134  C 

135 
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139 
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155 

156  C 

157  C 

158  C 

159  C 

160  C 
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VRITEO,*)  ’DRAWING  VECTOR  ’  ,K 

YE=YCE+J*DY 

XE=-B 

CALL  FNDTRI (XE,YE,MN,X,Y,MT,NT,N2T,ID) 

CALL  RVEC3D(XE,YE,ID,NDIR,MN,MT,MP ,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZDIC1,C2,C3,C4,C5,X0,Y0,VL,BANG 

k  ,S,MNAR,DS) 

XE=-B-A 

CALL  FNDTRI (XE,YE,MN,X,Y,MT,NT,N2T,ID) 

CALL  RVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX,FX,FY,GS,XDJYD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG 

k  ,S,MNAR,DS) 

CONTINUE 

CONTINUE 

**************************************************************** 

*  DRAW  VECTOR  LINES  ALONG  A  VERTICAL  LINE  WHICH  ORIGINATE  AT  * 

*  CRITICAL  POINT  5  AND  TERMINATE  ON  THE  PERIMETER  OF  SIDE  1.  * 

**************************************************************** 
NP=(NPY-l)/2 

DO  6  I=0,NP-1 
K=K+1 

WRITEC*,*)  'DRAWING  VECTOR  ’  ,K 
YE=4 . 5*DL+ (1 . O-TAUY) *0 . 5*DL+I*DY 
XE=-B 

CALL  FNDTRI (XE,YE,MN,X,Y,MT,NT,N2T, ID) 

NDIR=1 

VL=27 . O/GS-AH/GS 

CALL  RVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX,FX>FY,GS.XD,YD,ZD,C1,C2,C3.C4,C5,X0,Y0,VL,BANG 

k  ,S,MNAR,DS) 

NDIR-1 

VL=27. O/GS-AH/GS 
XE=-B-A 

CALL  FNDTRI (XE,YE,MN,X,Y,MT, NT, N2T, ID) 

CALL  RVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,Cl,C2,C3,C4,C5,X0,Y0tVL,BANG 

k  , S,MNAR,DS) 

CONTINUE 

ELSE  IF  (IS  .EQ.  2)  THEN 

**************************************************************** 

*  DRAW  SIDL  2  VECTORS  (X=A/2) .  * 

**************************************************************** 
**************************************************************** 

*  END  POINT  CONTRIBUTIONS.  * 

**************************************************************** 
XMIN— B 

XMAX-0.0 

XE«(XMIN+XMAX)/2.0 

NP-(NPY-l)/2 

K=0 

DO  7  I«0,NP-1 

YE=4 . 5*DL+ ( 1 . O-TAUY) *0 . 5*DL+I*DY 
K-K+l 

WRITE (*,*)  ’DRAWING  VECTOR  ’ ,K 
CALL  FNDTRI (XE,YE,MN,X,Y,MT, NT, N2T, ID) 

NDIR=0 

VL-20.0/GS 

CALL  RVEC3D (XE,YEIID,NDIR,MN,MT,MP,NT,N2T) T2N , X , Y , XMIN , XMAX 
k  ,YMIN,YMAX,FX,FYfGS,XD,YD,ZD,Cl,C2,C3,C4,C5,X0,Y0,VL,BANG 
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199  C 

200  C 

201  C 
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205 
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214 
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216 

217 
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219 

220  9 

221  8 
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223  C 

224  C 

225  C 

226  C 

227  C 

228  C 

229  C 

230 

231 

232 

233 

234 


ft  ,S,MNAR,DS) 

NDIR=1 

VL=20 . 0/GS-S/GS 

CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

CALL  RVEC3D (XE , YE , ID , NDIR , MN , MT , MP , NT , N2T , T2N ,  X ,  Y , XMIN , XMAX 
&  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG 

ft  ,S,MNAR,DS) 

YE=(I+1)*DY 

K=K+1 

WRITE(*,*)  ’DRAWING  VECTOR  »,K 
CALL  FNDTRI(XE,YE,MN,X,YJMT,NT,N2T,ID) 

NDIR-0 

VL-20.0/GS 

CALL  RVEC3D (XE ,YE,ID,NDIR,MN,HT,MP,NT, N2T ,T2N ,  X ,  Y , XMIN , XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG 

ft  ,S,MNAR,DS) 

NDIR-1 

VL=20. O/GS-S/GS 

CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

CALL  RVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y, XMIN, XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1 ,C2,C3,C4,CS,X0,Y0,VL,BANG 

ft  ,S,MNAR,DS) 

CONTINUE 

**************************************************************** 

*  INTERIOR  CONTRIBUTIONS.  * 

**************************************************************** 
DO  8  1=0 , KM- 2 

YCE=(1 . O-TAUY) *0 . 5*DL+0 . S*DL+I*DL 
DO  9  J-O.NPY-l 
K-K+l 

WRITE(*,*)  ’DRAWING  VECTOR  ’,K 

YE=YCE+J*DY 

NDIR-i 

VL-20. O/GS-S/GS 

CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

CALL  RVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2TfT2N,X,Y,XMIN,XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG 

ft  ,S,MNAR,DS) 

NDIR-0 
VL*20 . O/GS 

CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

CALL  RVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y, XMIN, XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG 

ft  .S.MNAR.DS) 

CONTINUE 

CONTINUE 

ELSE  IF  (IS  .EQ.  3)  THEN 

******************  *********************************************** 

*  DRAW  SIDE  3  (Y— B/2)  VECTORS.  * 

**************************************************************** 
**************************************************************** 

*  DRAW  VECTOR  LINES  ALONG  A  VERTICAL  LINE  WHICH  ORIGINATE  ON  * 

*  THE  PERIMETER  OF  SIDE  1  AND  TERMINATE  AT  CRITICAL  POINT  1.  * 
**************************************************************** 
K=0 

DO  10  I=l,(NPY-l)/2 
K-K+l 

WRITER, *)  ’DRAWING  VECTOR  ’  ,K 
YE-I+DY 
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250  C 
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275  C 
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XE=0 

CALL  FNDTRI(X£,YE,MN,X,Y,MT,NT,N2T,ID) 

NDIR=1 

VL=20 . 0/GS-AH/GS 

CALL  RVEC3D (XE,YE,ID,NDIR,MN,MT,MP,NT,N2T, T2N , X , Y , XMIN , XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG 

k  ,S,MNAR,DS) 

NDIR=1 

X£=A 

VL=20 . 0/GS-AH/GS 

CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

CALL  RVEC3D(XE, YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG 

k  ,S,MNAR,DS) 

CONTINUE 

**************************************************************** 

*  DRAW  VECTOR  LINES  ALONG  A  HORIZONTAL  LINE  WHICH  ORIGINATE  ON  * 

*  CRITICAL  POINT  2  AND  TERMINATE  ON  CRITICAL  POINT  1.  * 

**************************************************************** 
DXOFF= ( 1 . O-TAUX) *A/2 

DO  11  I=0,KM-1 
YE=0 . 5*DL+I*DL 
DO  12  J=0,NPX-1 
K=K+1 

WRITE (*,*)  'DRAWING  VECTOR  ’  ,K 
XE=DXOFF + J*DX 

CALL  FNDTRI (XE,YE,MN,X,Y,MT,NT,N2T,ID) 

NDIR-0 

VL=27.0/GS 

CALL  RVEC3D(XE,YE,ID>NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG 

k  ,S,MNAR,DS) 

NDIR-1 

VL-27. 0/GS-AH/GS 

CALL  RVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG 

ft  .S.MNAR.DS) 

CONTINUE 

CONTINUE 

**************************************************************** 

*  DRAW  VECTOR  LINES  ALONG  A  VERTICAL  LINE  WHICH  ORIGINATE  AT  * 

*  CRITICAL  POINT  2  AND  TERMINATE  ON  THE  PERIMETER  OF  SIDE  1.  * 

**************************************************************** 
DO  13  1*0, KM- 2 

YCE-(1 . O-TAUY) *0 . 5*DL+0 . 5*DL+I*DL 
IS»(-1)**(I+1) 

IF  (IS  >  0)  THEN 
NDIR-1 

VL*20 . O/GS-S/GS 
ELSE 
NDIR=0 
VL*20.0/GS 
END  IF 

DO  14  J*0,NPY-1 
K-K+l 

WRITE(*,*)  'DRAWING  VECTOR  ’,K 

YE*YCE+J*DY 

XE*0 

CALL  FNDTRI (XE, YE, MN,X,Y,MT,NT,N2T, ID) 
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307  C 

308 

309 

310 
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329  C 

330  C 
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CALL  RVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG 

k  ,S,MNAR,DS) 

XE=A 

CALL  FNDTRI (XE,YE,MN,X1Y,MT,NT,N2T,ID) 

CALL  RVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG 

k  ,S,MNAR,DS) 

CONTINUE 

CONTINUE 

**************************************************************** 

*  DRAW  VECTOR  LINES  ALONG  A  VERTICAL  LINE  WHICH  ORIGINATE  AT  * 

*  CRITICAL  POINT  5  AND  TERMINATE  ON  THE  PERIMETER  OF  SIDE  1.  * 

**************************************************************** 
NP=(NPY-i)/2 

DO  15  I-O.NP-l 
K=K+i 

WRITE(*,*)  ’DRAWING  VECTOR  ’,K 
YE=4 . 5*DL+ ( 1 . O-TAUY) *0 . 5*DL+I*DY 
XE-0 

CALL  FNDTRI (XE,YE,MN,X,Y,MT, NT, N2T, ID) 

NDIR=0 

VL-27.0/GS 

CALL  RVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG 

k  ,S,MNAR,DS) 

NDIR-0 
VL=27 . O/GS 
XE=A 

CALL  FNDTRI (XE, YE, MN,X,Y,MT, NT, N2T.ID) 

CALL  RVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1 ,C2,C3,C4,C5,X0 ,YO,VL,BANG 

k  , S.MNAR.DS) 

CONTINUE 

ELSE 

**************************************************************** 

*  DRAW  SIDE  4  (X=-A/2)  VECTORS.  * 

**************************************************************** 
**************************************************************** 

*  END  POINT  CONTRIBUTIONS.  * 

**************************************************************** 
XMIN-A 

XMAX-A+B 

XE” (XMIN+XMAX) /2 . 0 

NP”(NPY-l)/2 

K”0 

DO  16  I-O.NP-l 

YE”4 . 5*DL+ ( 1 . O-TAUY) *0 . 5*DL+I*DY 
K*K+1 

WRITER,*)  'DRAWING  VECTOR  ’ ,K 
CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

NDIR*0 

VL-20.0/GS 

CALL  RVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
k  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG 

k  ,S,MNAR,DS) 

NDIR”1 

VL“20 . O/GS-S/GS 

CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 
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357 

358 

359 

360 
36X 

362 

363 

364 

365 

366 

367 

368 

369 

370 

3 1 1  16 

372  C 

373  C 

374  C 

375 

376 

377 

378 

379 

380 

381 

382 

383 

384 

385 

386 

387 

388 

389 

390 
39 

391 

39?  18 

394  17 

395 

396 

397 


CALL  RVEC3DCXE, YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  , YMIN , YKAX , FX , FY , GS , XD , YD , ZD , Cl , C2 , C3 , C4 , C5 , XO , Y0 , VL , BANG 

&  .S.MNAR.DS) 

YE=(I+1)*DY 

K=K+1 

WRITE (*,*)  ’DRAWING  VECTOR  ’,K 
CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

NDIR=0 

VL=20.0/GS 

CALL  RVEC3D (XE , YE , ID , NDIR , MN , MT , MP , NT , N2T , T2N ,  X ,  Y , XMIN , XMAX 
&  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG 

ft  .S.MNAR.DS) 

NDIR=1 

VL=20.0/GS-S/GS 

CALL  FNDTRI(XE,YE,MN,X,Y,MT.NT,N2T,ID) 

CALL  RVEC3D(XE,YE>ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
&  ,YMIN,YMAX,FX,FY,GS.XD.YD,ZD,C1,C2.C3,C4,C5,X0,Y0,VL,BANG 

*  .S.MNAR.DS) 

CONTINUE 

****************************************************************** 
*  INTERIOR  CONTRIBUTIONS.  * 

****************************************************************** 
DO  17  1=0, KM- 2 

YCE- ( 1 . O-TAUY) *0 . 5*DL+0 . 5*DL+I*DL 
DO  18  J=0,NPY-1 
K=K+1 

WRITE!*,*)  ’DRAWING  VECTOR  ’ ,K 

YE=YCE+J*DY 

NDIR-1 

VL=20 . O/GS-S/GS 

CALL  FNDTRI (XE,YE,MN,X,Y,MT,NT,N2T,ID) 

CALL  RVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X.Y,XMIN,XMAX 
ft  >YMIN.YMAX,FX.FY,GS.XD,YD,ZD,C1,C2,C3,C4.C5.X0,Y0.VL,BANG 

ft  .S.MNAR.DS) 

NDIR=0 

VL-20.0/GS 

CALL  FNDTRI (XE .YE.MN.X.Y.MT.NT, N2T , ID) 

CALL  RVEC3D (XE,YE,ID,NDIR,MN,MT,MP,NT,N2T, T2N , X , Y , XMIN , XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1.C2 ,C3,C4,C5,X0,Y0,VL,BANG 

ft  .S.MNAR.DS) 

CONTINUE 
CONTINUE 
END  IF 
RETURN 
END 


1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 


SUBROUTINE  RVEC3D(XE,YE,ID,NDIR,KN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  .YMIN.YMAX.FX.FY.GS.XD, YD.ZD.Cl ,C2 ,C3,C4,C5,X0,Y0,VL,BANG 
ft  .S.MNAR.DS) 

****************************************************************** 

*  THIS  SUBROUTINE  DRAWS  A  VECTOR  LINE.  * 

****************************************************************** 

*  INPUTS:  * 


*  * 

*  XE, YE  -  FIRST  COORDINATE  OF  VECTOR  LINE.  * 

*  MN  -  MAXIMUM  NUMBER  OF  COORDINATE  POINTS.  * 

*  MT  -  MAXIMUM  NUMBER  OF  TRIANGLES.  * 

*  N2T(MT,3)  -  NODE  MATRIX  WHERE  FIRST  INDEX  REPRESENTS  * 

*  EACH  TRIANGLE  AND  SECOND  INDEX  REPRESENTS  * 
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14  C 

♦ 

THE  NODE  NUMBERS. 

♦ 

15  C 

* 

T2N(MN,MP)  -  MATRIX  OF  TRIANGLE  TO  NODE  CONNECTIONS 

♦ 

16  C 

♦ 

WHERE  THE  FIRST  INDEX  IS  THE  NODE  NUMBER 

* 

17  C 

* 

AND  THE  SECOND  IS  THE  LOCAL  TRIANGLE  NUMBER. 

* 

18  C 

* 

X(MN) 

-  COORDINATE  VECTORS  OF  GRID. 

* 

19  C 

* 

Y(MN) 

♦ 

20  C 

* 

FX(MN) 

-  VECTOR  FUNCTION  FIELD  VALUES  AT  EACH  COORDINATE. 

♦ 

21  C 

♦ 

FY(MN) 

* 

22  C 

* 

AX.BX 

-  GRAPHICAL  SCALE  CONSTANTS. 

* 

23  C 

* 

AY,  BY 

* 

24  C 

* 

VL 

-  SPACING  BETWEEN  ARROWHEADS  IN  REAL  COORDINATES. 

* 

25  C 

* 

BANG 

-  ARROW  APEX  HALF  ANGLE  IN  DEGREES. 

* 

26  C 

♦ 

S 

-  ARROW  HEAD  SIDE  LENGTH  IN  POINT  SIZE. 

* 

27  C 

* 

MNAR 

-  MAXIMUM  NUMBER  OF  ARROWS  ALLOWED. 

* 

28  C 

* 

DS 

-  STEP  SIZE. 

* 

29  C 

* 

* 

30  C 

* 

OUTPUTS: 

* 

31  C 

* 

♦ 

c  ***************************************************************** 

REAL*4  X(MN),Y(MN),FX(MN),FY(MN) 

INTEGER  N2T(MT,3) ,T2N(MN,MP) 

C  ****************************************************************** 

C  *  STORE  THE  FIRST  TRIANGLE  NUMBER.  * 

C  ****************************************************************** 

IFIRST-ID 

C  ****************************************************************** 

C  *  STORE  THE  FIRST  POINT.  * 

C  ****************************************************************** 

AWIDTH-1 .0 
BWIDTH-AWIDTH/2.0 
XFIRST-XE 
YFIRST=YE 

C  ****************************************************************** 

C  *  TRANSFORM  THE  INITIAL  POINT.  * 

C  ****************************************************************** 

CALL  MPRPNT (XE , YE , AVIDTH , BWIDTH , XAT ,  YAT , ZAT) 

CALL  TRFPNT(XAT,YAT,ZAT,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0) 
WRITE(l.lOO)  XAT, YAT,’  noveto’ 

C  ****************************************************************** 

C  *  BEGIN  THE  VECTOR  SEGMENTS.  * 

C  ****************************************************************** 

K-0 

VSUM-0.0 

KAR-0 

999  CONTINUE 

K-K+l 

C  WRITEC* ,*)  ’SEGMENT  NUMBER-  ’ ,K, ’  TRIANGLE  NUMBER-  ’.ID 
C  ****************************************************************** 

C  *  IF  THIS  IS  NOT  THE  FIRST  LINE  THEN  DETERMINE  WHAT  TRIANGLE  * 

C  *  THE  DRAWN  LINE  CONNECTS  TO  BY  LOOKING  AT  THE  TWO  NODES  NA  AND  * 

C  *  NB  FORMING  THE  LAST  INTERSECTION.  * 

C  ****************************************************************** 

IF  (K  .GT.  1)  THEN 
IF  (K  .GT.  300)  THEN 
GO  TO  99 
ELSE 
END  IF 

IF  (ID  .EQ.  0)  THEN 

C  ************************************************************** 
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73  C 

74  C 

75  C 

76 

77 

78 

79  C 

80  C 

81 
82 

83 

84 

85 

86 

87 

88 

89  C 

90  C 

91  C 

92 

93  C 

94  C 

95  C 

96 

97 

98 

99 
100 
101 
102 

103 

104 

105 

106 

107 

108  C 

109  C 

110  C 

111 
112 

113  C 

114 

115  C 

116  C 

117 

118  C 

119  C 

120  C 

121  C 

122 

123 

124 

125 

126 

127 

128 

129 

130 

131 


♦  THERE  IS  NO  NEXT  TRIANGLE  WHICH  MEANS  THE  VECTOR  * 

*  TERMINATES  ON  A  BOUNDARY.  * 

************************************************************** 

WRITE(*,*)  ’TERMINATE  ON  BOUNDARY  TRIANGLE’ 

GO  TO  99 

ELSE  IF  (ID  .EQ.  IFIRST)  THEN 

WRITEC* ,*)  ’BACK  TO  ORIGINAL  TRIANGLE’ 

GO  TO  99 
ELSE 
END  IF 
XA=XF 
YA=YF 
ELSE 
XA=XE 
YA=YE 
END  IF 

****************************************************************** 

*  FIND  THE  VECTOR  FUNCTION  VALUE  AT  THE  POINT  (XA.YA).  * 

****************************************************************** 
CALL  VECC0F(MN,MT,ID,X,Y,XA,YA,N2T,FX,FY,A,B,E,C,D,F) 
****************************************************************** 

*  GET  THE  VECTOR  COMPONENTS  AT  THE  POINT  (XA.YA) .  * 

****************************************************************** 
FYA“A*XA+B*YA+E 

FXA*C*XA+D*YA+F 
FM»SQRT (FXA*FXA+FYA*FYA) 

FXN-FXA/FM 

FYN-FYA/FM 

IF  (NDIR  .Eq.  0)  THEN 
XF=XA+DS*FXN 
YF*YA+DS*FYN 
ELSE 

XF-XA-DS*FXN 
YF*YA-DS*FYN 
END  IF 

****************************************************************** 

*  GET  THE  NEXT  TRIANGLE  NUMBER.  * 

****************************************************************** 
IDOLD-ID 

CALL  FDSTRI (XF,YF,MN,X,Y,MT,MP,NT,N2T,T2N,ID0LD,ID) 

VRITE(*,*)  ’ITERATION*  ’ ,K,IDOLD,ID,XF,YF,FXA,FYA 
IF  (ID  .Eq.  IFIRST)  THEN 
XF-XFIRST 
YF=YFIRST 

ELSE  IF  (ID  .Eq.  0)  THEN 
WRITE(*,*)  ’BOUNDARY  NODE’ 

**************************************************************** 
*  ADJUST  THE  POINT  IF  IT  IS  OUTSIDE  THE  BOUNDARY.  * 

**************************************************************** 
IF  (XF  .LT.  XMIN)  THEN 
XF-XMIN 

ELSE  IF  (XF  .GT.  XMAX)  THEN 
XF-XMAX 
ELSE 
END  IF 

IF  (YF  .LT.  YMIN)  THEN 
YF-YMIN 

ELSE  IF  (YF  .GT.  YMAX)  THEN 
YF-YMAX 
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132 

133 

134  C 

135  C 

136  C 

137 

138 

139 

140 

141 

142  C 

143  C 

144  C 

145 

146 

147 

148 

149 

150 

151 

152 

153 

154 

155 

156 

157  C 

158  C 

159  C 

160  C 

161  C 

162  C 

163 

164 

165 

166  C 

167  C 

168  C 

169 

170 

171 

172 

173 

174 

175 

176 

177 

178 

179 

180 
181 
182 

183 

184 

185 

186  C 

187  C 

188  C 

189  99 

190 


ELSE 
END  IF 

**************************************************************** 

*  DRAW  THE  LINE  FROM  (XA.YA)  TO  (XF.YF).  * 

**************************************************************** 

CALL  MPRPNT(XF,YF,AWIDTH,BWIDTH,XFT,YFT,ZFT) 

CALL  TRFPNT (XFT , YFT , ZFT , GS , XD , YD , ZD , Cl , C2 , C3 , C4 , C5 ,X0 , YO) 
WRITE(l.lOO)  XFT, YFT,'  lineto’ 

GO  TO  99 
END  IF 

****************************************************************** 

*  ADJUST  THE  POINT  IF  IT  IS  OUTSIDE  THE  BOUNDARY.  * 

****************************************************************** 

IF  (XF  .LT.  XMIN)  THEN 

XF-XMIN 

ELSE  IF  (XF  .GT.  XMAX)  THEN 
XF=XMAX 
FTSF 

END  IF 

IF  (YF  .LT.  YMIN)  THEN 
YF-YMIN 

ELSE  IF  (YF  .GT.  YMAX)  THEN 
YF-YMAX 
FTSF 

END  IF 

****************************************************************** 

*  DRAW  THE  LINE  FROM  (XA.YA)  TO  (XF.YF).  * 

****************************************************************** 
****************************************************************** 

*  TRANSFORM  THE  POINT.  * 

****************************************************************** 

CALL  MPRPNT(XF.YF,AWIDTH.BWIDTH,XFT.YFT,ZFT) 

CALL  TRFPNT(XFT,YFT,ZFT,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0) 
WRITE(l.lOO)  XFT. YFT, ’  lineto’ 

****************************************************************** 

*  DRAW  ARROW  OR  ARROWS  IF  APPROPRIATE.  * 

****************************************************************** 

DAR-SQRT ( (XA-XF) * (XA-XF) +(YA-YF) *(YA-YF) ) 

IF  (DAR  .GT.  0.0)  THEN 
IF  (NDIR  .Eq.  0)  THEN 

CALL  RARR3D(MNAR,VL,BANG,S , XA.YA, XF.YF, FXN.FYN.VSUM.KAR 
t  .GS.XD, YD.ZD.Cl ,C2,C3,C4,C5,X0,Y0) 

ELSE 

CALL  RARR3D(MNAR,VL, BANG, S, XF.YF, XA.YA, FXN.FYN.VSUM.KAR 
t  ,GS,XD,YD,ZD,C1 ,C2,C3,C4,C5,X0,Y0) 

END  IF 

FT-SF 

END  IF 

IF  (FM  .LT.  .001)  THEN 

WRITE(*,*)  ’CLOSE  TO  AN  UNKNOWN  CRITICAL  POINT’ 

GO  TO  99 
ELSE 
END  IF 
GO  TO  999 

****************************************************************** 

*  STOP.  * 

****************************************************************** 

CONTINUE 

WRITE(1,*)  ’stroke’ 
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191  100  F0RMAT(2(F6.2, IX) ,A7) 

192  ID-IFIRST 

193  RETURN 

194  END 


1  SUBROUTINE  RARR3D (MN AR, VL, BANG, S, XA ,YA,XF,YF, FXN, FYN, VSUM, KAR 

2  ft  ,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0) 

3  C  ****************************************************************** 

4  C  *  THIS  SUBROUTINE  CONTROLS  THE  DRAWING  OF  ARROWHEADS  ON  A  LINE.  * 

5  C  ****************************************************************** 


6 

C 

* 

INPUTS: 

* 

7 

C 

* 

* 

8 

C 

* 

MNAR 

- 

MAXIMUM  NUMBER  OF  ARROWS  ALLOWED. 

* 

9 

c 

* 

VL 

- 

SPACING  BETWEEN  ARROWHEADS  IN  REAL  COORDINATES. 

* 

10 

c 

* 

BANG 

- 

ARROW  APEX  HALF  ANGLE  IN  DEGREES. 

* 

11 

c 

* 

S 

- 

ARROW  HEAD  SIDE  LENGTH  IN  POINT  SIZE. 

* 

12 

c 

* 

XA.YA 

- 

BASE  OF  ARROW. 

* 

13 

c 

* 

XF.YF 

- 

TIP  OF  ARROW. 

* 

14 

c 

♦ 

FXN, FYN 

- 

NORMALIZED  VECTOR  FUNCTION  VALUES. 

♦ 

15 

c 

* 

VSUM 

- 

ACCUMULATED  LINE  LENGTH. 

♦ 

16 

c 

* 

KAR 

- 

NUMBER  OF  ARROWS  DRAWN  SO  FAR. 

* 

17 

c 

* 

AX,BX 

- 

GRAPHICAL  SCALE  CONSTANTS. 

* 

18 

c 

* 

AY, BY 

* 

19  C  ****************************************************************** 

20  D=SQRT( (XA-XF) * (XA-XF) +(YA-YF) * (YA-YF) ) 

21  STEP=VSUM+D 

22  IF  (STEP  .GT.  VL)  THEN 

23  KAR-KAR+1 

24  IF  (KAR  .GT.  KNAR)  THEN 

25  GO  TO  2 

26  ELSE 

27  END  IF 

28  C  **************************************************************** 

29  C  *  THE  NEXT  LINE  SEGMENT  IS  LONGER  THAN  THE  ARROW  SPACING.  * 

30  C  *  SO  AN  ARROW  SHOULD  BE  DRAWN.  * 

31  C  **************************************************************** 

32  RAT* ( VL-VSUM) /D 

33  XFW-XA+RAT* (XF-XA) 

34  YFW*YA+RAT* (YF-YA) 

35  C  **************************************************************** 


36  C 

37  C 

38 

39 

40  C 

41  C 

42  C 

43 

44 

45  C 

46  C 

47  C 

48 

49 

50  C 

51  C 

52  C 

53 

54 


*  DRAW  THE  ARROW.  * 

**************************************************************** 
CALL  RAHD3D (BANG , GS , S , XFW , YFW , FXN , FYN , XD , YD , ZD , Cl , C2 

ft  ,C3,C4,C5,X0,Y0) 

**************************************************************** 

*  COMPUTE  THE  AMOUNT  LEFT  OVER  AFTER  THE  ARROW  IS  DRAWN.  * 

**************************************************************** 
DLT*SQRT( (XF-XFW) * (XF-XFW) + (YF-YFW) * (YF-YFW) ) 

IF  (DLT  .LT.  VL)  THEN 

************************************************************** 

*  NO  MORE  ARROWS  ARE  DRAWN  ON  THIS  SEGMENT.  * 

************************************************************** 
VSUM-DLT 

ELSE 

************************************************************** 

♦  MORE  THAN  ONE  ARROW  IS  DRAWN  ON  THIS  SEGMENT.  * 

************************************************************** 
NAR-DLT/VL 

DO  1  1=1 ,NAR 
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55 

56 

57 

58 

59 

60 
61 
62 

63 

64 

65  1 

66 

67 

68 

69  C 

70  C 

71  C 

72  C 

73  C 

74 

75 

76  2 

77 

78 


KAR=KAR+1 

IF  (KAR  .GT.  MNAR)  THEN 
GO  TO  2 

FT-SF. 

END  IF 

RAT= (VL-VSUM+I*VL) /D 
XFW=XA+RAT*(XF-XA) 

YFW=YA+RAT* (YF-YA) 

CALL  RAHD3D(BANG,GS,S,XFW,YFW,FXN,FYN,XD,YD,ZD,C1,C2 
ft  ,C3,C4,C5,X0,Y0) 

CONTINUE 

VSUM=SQRT ( (XF-XFW) * (XF-XFW) + (YF-YFW) * (YF-YFW) ) 

END  IF 
ELSE 

**************************************************************** 

*  THE  LINE  LENGTH  PLUS  THE  ACCUMULATED  DISTANCE  IS  STILL  LESS  * 

*  THAN  THE  ARROW  SPACING.  NO  ARROW  SHOULD  BE  DRAWN  JUST  * 

*  ACCUMULATE  THE  DISTANCE.  * 

**************************************************************** 
VSUM=VSUM+D 

END  IF 
CONTINUE 
RETURN 
END 


1  SUBROUTINE  RAHD3D(BANG,GS,S,X2,Y2>FXN,FYN,XD,YD,ZD,Ci,C2 

2  ft , C3 , C4 , C5 , XO , YO) 

3  C  ****************************************************************** 


4  C  *  THIS  SUBROUTINE  DRAWS  A  ARROW  HEAD  FROM  (XI, Yl)  TO  (X2,Y2).  * 

5  C  ****************************************************************** 

6  C  *  INPUTS:  * 

7  C  *  * 

8  C  *  BANG  -  ARROW  APEX  HALF  ANGLE  IN  DEGREES.  * 

9  C  *  S  -  ARROWHEAD  SIDE  LENGTH.  * 

10  C  *  X2.Y2  -  TIP  OF  ARROW.  * 

11  C  *  FXN.FYN  -  NORMALIZED  VECTOR  FUNCTION  VALUES.  * 


12  C  ****************************************************************** 

13  RAD* . 17453293E-01 

u  X1-X2-FXN 

15  Y1-Y2-FYN 

18  D*SQRT( (X2-X1) * (X2-X1) + (Y2-Y1) * (Y2-Y1) ) 

17  A*1.0-S/(GS*D) 

18  X3*X1+A* (X2-X1) 

19  Y3*Y1+A*(Y2-Y1) 

20  C  ****************************************************************** 

21  C  *  TRANSLATE  THE  ORIGIN  TO  (X2.Y2)  AND  ROTATE  (X3,Y3)  PLUS  AND  * 

22  C  *  MINUS  BANG  DEGREES  TO  GENERATE  THE  VERTICES  OF  THE  ARROW.  * 

23  C  ****************************************************************** 

?4  XA-X3-X2 

25  YA-Y3-Y2 

26  ARG-RAD*BANG 

27  CA-COS(ARG) 

28  SA-SIN(ARG) 

29  XCA-XA*CA 

30  XSA»XA*SA 

31  YCA-YA*CA 

32  YSA-YA*SA 

33  X4-X2+XCA-YSA 

34  Y4-Y2+XSA+YCA 
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35  X5=X2+XCA+YSA 

36  Y5=Y2-XSA+YCA 

37  c  X6= (X4+X5) /2 . 0 

38  c  Y6=(Y4+Y5)/2.0 

39  C  WRITE (1,*)  XI, Yl,’  moveto’ 

40  C  WRITECl, ♦)  X6 ,Y6, ’  lineto  stroke’ 

41  C  ****************************************************************** 

42  C  *  TRANSLATE  THE  ORIGIN  TO  (X2,Y2)  AND  ROTATE  (X3.Y3)  PLUS  AND  * 

43  C  *  MINUS  BANG  DEGREES  TO  GENERATE  THE  VERTICES  OF  THE  ARROW  * 

44  C  ****************************************************************** 

45  AWIDTH=1.0 

46  BWTDTH=0 . 5 

47  CALL  MPRPNT (X2 ,Y2 , AWIDTH .BWIDTH , X2T , Y2T , Z2T) 

48  CALL  MPRPNT (X4.Y4. AWIDTH, BWIDTH, X4T,Y4T,Z4T) 

49  CALL  MPRPNT (X5.Y5, AWIDTH, BWIDTH, X5T.Y5T.Z5T) 

so  CALL  TRFPNT (X2T , Y2T , Z2T , GS , XD , YD , ZD , Cl , C2 , C3 , C4 , C5 , XO , YO) 

51  CALL  TRFPNT (X4T , Y4T , Z4T , GS , XD , YD , ZD , Cl , C2 , C3 , C4 , C5 , XO , YO) 

52  CALL  TRFPNT (X5T , Y5T , Z5T , GS , XD , YD , ZD , Cl , C2 , C3 , C4 , C5 , XO , YO) 

53  WRITECl,*)  ’gsave  newpath’ 

54  WRITECl,*)  X2T.Y2T, ’  moveto  ’,X4T,Y4T,’  lineto  ’ 

55  4  ,X5T,Y5T, ’  lineto’ 

56  WRITECl,*)  ’ closepatb  0  setgray  fill  stroke  grestore’ 

57  RETURN 

58  END 

1  SUBROUTINE  MPRPNTCU,V,A,B,X.Y,Z) 

2  C  ****************************************************************** 


3  C  *  THIS  SUBROUTINE  MAPS  A  POINT  FROM  THE  UNNFOLDED  WAVEGUIDE  * 

4  C  *  CU.V)  SPACE  TO  THE  CX.Y.Z)  FOLDED  WAVEGUIDE  SPACE.  * 

5  C  ****************************************************************** 

6  C  *  INPUTS:  * 

7  C  *  * 

8  C  *  U.V  -  COORDINATES  OF  THE  UNFOLDED  WAVEGUIDE  POINT.  * 

9  C  *  A  -  X  DIMENSION  OF  WAVEGUIDE  SUCH  THAT  -A/2  <=  X  <=  A/2.  * 

10  C  *  B  -  X  DIMENSION  OF  WAVEGUIDE  SUCH  THAT  -B/2  <=  Y  <«  B/2.  * 

11  C  *  * 

12  C  *  OUTPUTS:  * 

13  C  *  * 

14  C  *  X,Y,Z  -  COORDINATES  OF  MAPPED  POINT.  * 


15  C  ****************************************************************** 

16  IF  CCU  .GE.  -A-B)  .AND.  CU  .LT.  -B))  THEN 

17  X=U+B+A/2 . 0 

18  Y*B/2.0 

19  ELSE  IF  CCU  .GE.  -B)  .AND.  CU  .LT.  0.0))  THEN 

20  X=A/2 . 0 

21  Y=-U-B/2.0 

22  ELSE  IF  CCU  .GE.  0.0)  .AND.  CU  .LT.  A))  THEN 

23  X— U+A/2.0 

24  Y*-B/2 . 0 

25  ELSE 

26  X— A/2.0 

27  Y«U-A-B/2.0 

28  END  IF 

29  Z-V 

30  RETURN 

31  END 
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PROGRAM  FLDCIR 

****************************************************************** 

*  THIS  PROGRAM  GENERATES  A  VECTOR  PLOT  OF  THE  TRIANGULARIZED  * 

*  REGION  OF  A  CIRCULAR  WAVEGUIDE.  * 

****************************************************************** 

*  TIMOTHY  J.  PETERS  LAST  UPDATED  * 

*  THE  AEROSPACE  CORPORATION  5/12/92  * 

*  2350  EAST  EL  SEGUNDO  BOULEVARD  * 

*  EL  SEGUNDO,  CA  90245  * 

****************************************************************** 
PARAMETER  (MN=6000 ,MT= 12000 , MP=6 , NC=5 ,NL=6) 

REAL*4  U(MN) ,V(MN) ,FU(MN) ,FV(MN) ,PHI(50) ,CA(NC) ,CB(NC) 

REAL *4  Xq(3),YQ(3),ZQ(3) 

REAL*8  ARG 
INTEGER  LC(NC) 

CHARACTER* 30  LABEL (NL) 

INTEGER*4  N2T (MT , 3) , T2N (MN , MP) 

PI= . 3141593E+01 
TP= . 6283153E+01 
RAD= . 17453293E-01 

****************************************************************** 


*  INPUTS:  * 

*  * 

*  GS  -  GRAPH  SCALE  CONSTANT.  * 

*  PO  -  PHI  OBSERVATION  ANGLE  (DEGREES).  * 

*  TO  -  THETA  OBSERVATION  ANGLE  (DEGREES) .  * 


****************************************************************** 

P0=50 . 0 
T0=60 . 0 

****************************************************************** 

*  READ  THE  COORDINATE  DATA  AND  VECTOR  FUNCTION  DATA  FROM  A  FILE.  * 
****************************************************************** 

OPEN (UNIT=1 , FILE* ’ CUVFDF » ) 

READ(1,*)  A,C,KM,N,M 
READ(1,*)  NU.NV 
READ(1,*)  NN 
VMAX=0.0 
DO  1  1*1, NN 

READ(1,*)  U(I),V(I),FU(I),FV(I) 

VMAG=SQRT (FU (I) *FU(I)+FV(I) *FV(I) ) 

IF  (VMAG  .GT.  VMAX)  THEN 
VMAX-VMAG 
ELSE 
END  IF 
CONTINUE 
CLOSE(l) 

VRITE(*,*)  NN,'  DATA  POINTS  READ  IN’ 
****************************************************************** 

*  NORMALIZE  THE  VECTOR  COMPONENTS  SO  THAT  THE  MAXIMUM  MAGNITUDE  * 

*  IS  1.0.  * 

****************************************************************** 


52  DO  2  1=1, NN 

53  FU(I)=FU(I)/VMAX 

54  FV ( I ) =FV ( I ) /VMAX 

55  2  CONTINUE 

56  C  ****************************************************************** 

57  C  *  READ  THE  TRIANGLE  NODE  DATA.  * 

58  C  ****************************************************************** 

59  OPEN (UNIT* 1,FILE='N2TDAT’) 
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60  READ(1,*)  NT 

61  DO  3  1=1, NT 

62  READ(1,*0  N2T(I,1),N2T(I,2),N2T(I,3) 

63  3  CONTINUE 

64  CLOSE(l) 

65  WRITE(*,*)  'NODE  TO  TRIANGLE  DATA  READ  IN' 

66  C  ****************************************************************** 

67  C  *  READ  THE  TRIANGLE  TO  NODE  CONNECTION  DATA.  * 

68  C  ****************************************************************** 

69  0PEN(UNIT=1,FILE=’T2NDAT') 

70  READC1,*)  NN 

71  DO  4  1=1, NN 

72  READCl,*)  (T2N(I, J) ,J=1,MP) 

73  4  CONTINUE 

74  CLOSE(l) 

75  WRITEC*,*)  'TRIANGLE  TO  NODE  DATA  READ  IN' 

76  C  ****************************************************************** 

77  C  *  COMPUTE  CENTROID  OF  GRAPH.  * 

78  C  ****************************************************************** 

79  GS=180.0 

80  XMIN=-A/2 . 0 

si  XMAX=A/2 . 0 

82  YMIN=-A/2.0 

83  YMAX=A/2.0 

84  ZMIN=0 . 0 

85  ZMAX=C 

86  XC= (XMIN+XMAX) /2 . 0 

87  YC= (YMIN+YMAX) /2 . 0 

88  ZC= (ZMIN+ZMAX) /2 . 0 

89  C  ****************************************************************** 

90  C  *  CONVERT  THE  OBSERVATION  ANGLES  TO  RADIANS.  * 

91  C  ****************************************************************** 

92  RAD= . 17453293E-01 

93  PI=.3141593E+01 

94  PI4=PI/4.0 

95  XD=XC 

96  YD=YC 

97  ZD=ZC 

98  CALL  SCALE(GS,XD,YD,ZD) 

99  C  ****************************************************************** 

100  C  *  CONVERT  THE  OBSERVATION  ANGLES  TO  RADIANS.  * 

101  C  ****************************************************************** 

102  POBS=RAD*PO 

103  TQBS=RAD*TO 

104  C  ****************************************************************** 

105  C  *  COMPUTE  THE  ROTATION  ANGLES  WHICH  YIELD  THE  DESIRED  OBSERVATION* 

106  C  *  ANGLES.  * 

107  C  ****************************************************************** 

108  RP=-P0BS-PI/2 . 0 

109  RT=T0BS 

no  C  ****************************************************************** 

111  C  *  COMPUTE  THE  CONSTANTS  FOR  THE  ROTATION  MATRIX.  * 

112  C  ****************************************************************** 

113  CALL  RC0EFF(RP,RT,C1,C2,C3,C4,C5) 

114  C  ****************************************************************** 

115  C  *  COMPUTE  THE  CENTER  OF  THE  PRINTING  DEVICE  PAGE.  * 

116  C  ****************************************************************** 

117  X0=72*8. 5/2.0 

118  Y0=72* 11. 0/2.0 
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119  C  ****************************************************************** 

120  C  *  SET  THE  GRAPHIC  BOUNDING  BOX.  * 

121  C  ****************************************************************** 

122  WX= CXMAX-XMIN) 

123  WY= ( YMAX-YMIN) 

124  WIDTH=GS*WX 

x?s  HEIGHT=GS*WY 

126  UA=X0-WIDTH/2. 0-48.0 

127  UB=X0+WIDTH/2. 0^91.0 

128  VA=Y0-HEIGHT/2. 0-243.0 

129  VB=Y0+HEIGHT/2. 0+239.0 

130  C  ****************************************************************** 

131  C  *  COMPUTE  THE  BOUNDING  BOX  FOR  THE  POSTSCRIPT  IN  THE  DEFAULT  * 

132  C  *  COORDINATE  SYSTEM.  * 

133  C  ****************************************************************** 

134  OPEN (UNIT=1 .FILE- ’ FoldedCirc .  ps  ’ ) 

135  REWIND  1 

136  WRITECl,*)  ’% IPS  Adobe-1.0’ 

m  WRITE (1,*)  "/^Creator:  Timothy  J.  Peters’ 

138  WRITE (1,*)  "/.'/.Title:  Graph’ 

130  WRITECl.*''  "/.'/.CreationDate:  5-14-92’ 

l<  WRITEC  1,1.00)  "/.XBoundingBox:  ’ .INTCUA) .INTCVA) .INTCUB) ,INT(VB) 

141  100  FORMAT  (A14,4(1X,  13)) 

142  WRITECl , *)  ’ ‘/.XEndComments  ’ 

143  WRITECl,*)  ’/dot2  {2  0  360  arc  0  setgray  fill  stroke}  def’ 

144  WRITECl,*)  ’/dot3  -[3  0  360  arc  0  setgray  fill  stroke}  def’ 

145  WRITECl.*)  ’/dot4  -[4  0  360  arc  0  setgray  fill  stroke}  def’ 

146  WRITECl,*)  ’/black  {000  setrgbcolor}  def’ 

147  WRITECl,*)  ’/white  {111  setrgbcolor}  def’ 

148  WRITECl,*)  ’/gray- It  {0.92  0.92  0.92  setrgbcolor}  def’ 

149  WRITECl,*)  ’ /gray-lt-med  {0.65  0.65  0.65  setrgbcolor}  def’ 

iso  WRITECl,*)  ’/gray  {0.45  0.45  0.45  setrgbcolor}  def’ 

isi  WRITECl,*)  ’ /gray-dk-med  {0.3  0.3  0.3  setrgbcolor}  def’ 

152  WRITECl,*)  ’/gray-dk  {0.14  0.14  0.14  setrgbcolor}  def’ 

153  WRITECl,*)  ’/red  {100  setrgbcolor}  def’ 

154  WRITECl,*)  ’/magenta  {101  setrgbcolor}  def’ 

155  WRITECl,*)  ’/green  {010  setrgbcolor}  def’ 

156  WRITECl,*)  ’/blue  {001  setrgbcolor}  def’ 

157  WRITECl,*)  ’/cyan  {Oil  setrgbcolor}  def’ 

158  WRITECl,*)  ’/yellow  {110  setrgbcolor}  def’ 

159  WRITECl,*)  ’/orange  {1  0.5  0  setrgbcolor}  def’ 

160  WRITECl,*)  ’/brown  {0.5  0.5  0  setrgbcolor}  def’ 

161  WRITECl,*)  ’/kakhi  {0.5  1  0  setrgbcolor}  def’ 

162  WRITECl,*)  ’/blue- It  {0.5  1  1  setrgbcolor}  def’ 

163  WRITECl,*)  ’/green-lt  {0.5  1  0.5  setrgbcolor}  def’ 

164  WRITECl,*)  ’/green-blue  {0  1  0.5  setrgbcolor}  def’ 

165  WRITECl,*)  ’/purple  {0.6  0  1.0  setrgbcolor}  def’ 

166  WRITECl,*)  ’/filtri  {moveto  lineto  lineto’ 

167  WRITECl,*)  ’  closepath  fill  stroke}  def’ 

168  WRITECl,*)  ’/filqud  {moveto  lineto  lineto  lineto  closepath  fill’ 

169  WRITECl,*)  ’  stroke}  def’ 

170  WRITECl,*)  ’/filpnt  {moveto  lineto  lineto  lineto’ 

171  WRITECl,*)  ’  lineto  closepath  fill  stroke}  def’ 

172  WRITECl ,  *)  ’ '/.XEndProlog ’ 

173  WRITECl,*)  ’1  setlinejoin  .4  retlinewidth’ 

174  C  ****************************************************************** 

175  C  *  DRAW  THE  EPS  BOUNDING  BOX.  * 

176  C  ****************************************************************  *  « 

177  C  WRITECl,*)  ’gsave  0.2  setlinewidth’ 
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178  C  WRITE (1,*)  UA.VA, ’  moveto’ 

179  C  WRITE(1,*)  UB.VA, ’  lineto’ 

iso  C  WRITECl,*)  UB.VB, ’  lineto’ 

181  C  WRITE(1,*)  UA,VB, ’  lineto’ 

182  C  WRITE(1,*)  ’closepath  stroke  grestore’ 

183  C  ****************************************************************** 

184  C  *  ASSIGN  CONTOUR  VALUES  AND  LABELS.  * 

185  C  ****************************************************************** 

186  CA(1)=0.0 

187  CB(1)=0. 15 

188  CA(2)=0.15 

189  CB(2)=0.4 

190  CA(3)=0.4 

191  CB(3)=0.6 

192  CA(4)=0.6 

193  CB(4)=0.8 

194  CA(5)=0.8 

195  CB(5)=1 .0 

196  LABEL  ( 1 )  =  ’  0  ’ 

197  LABEL(2)=’.l5’ 

198  LABEL(3)=’.4’ 

199  LABEL(4)=’.6’ 

200  LABEL(5)=’ .8’ 

201  LABEL(6)=’ 1 ’ 

202  C  ****************************************************************** 

203  C  *  ASSIGN  THE  COLORS.  SEE  SUBROUTINE  SETCOL  FOR  COLOR  CHOICES.  * 

204  C  ****************************************************************** 

205  C  GRAY  SCALE 

206  LC(1)=2 

207  LC(2)=3 

208  LC(3)=4 

209  LC(4)=5 

210  LC(5)=6 

211  C  COLOR 

212  c  LC(1)=18 

213  c  LC(2)=14 

214  c  LC(3)=12 

215  c  LC(4)=16 

216  c  LC(5)”13 

217  IF  (PO  .LE.  90.0)  THEN 

218  XCMIN= (RAD* (P0+90 . 0) ) *A 

219  XCHAX=(RAD*  (PO-^270 . 0)  )  *A 

220  ELSE 

221  END  IF 

222  XMIN*0 . 0 

223  XMAX=TP*A 

224  YMIN=0 . 0 

225  YMAX-C 

226  C  ****************************************************************** 

227  C  *  DRAW  THE  BACK  SIDE  OF  THE  CYLINDER.  * 

228  C  ****************************************************************** 

229  KUS*INT ( 1+(NU-1) * (P0+90 . 0) /360 . 0) 

230  ITMIN=2*(KUS-1) * (NV-1)+1 

231  KUSM=KUS+ (NU+ 1 ) /2 

232  ITMAX“2*(KUSM-1)*(NV-1) 

233  C  ****************************************************************** 

234  C  *  PROCESS  TRIANGLES.  * 

236  C  ****************************************************************** 

236  DO  5  I-ITMIN.ITMAX 
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N1=N2T(I,1) 

N2“N2T(I,2) 

N3=N2T(I,3) 

F1=SQRT(FU(N1)*FU(N1)+FV(N1)*FV(N1) ) 
F2=SQRT(FU(N2)*FU(N2)+FV(N2)*FV(N2) ) 

F3=SQRT(FU(N3)*FU(N3) +FV(N3)*FV(N3) ) 

CALL  MPCPNT(U(N1) ,V(N1) ,A,XQ(1) ,YQ(1) ,ZQ(1)) 

CALL  MPCPNT(U(N2) ,V(N2) ,A,XQ(2) ,YQ(2) ,ZQ(2)> 

CALL  MPCPNT(U(N3) ,V(N3) ,A,Xq(3) ,YQ(3) ,Zq(3)) 

************************************************************** 

*  TRANSFORM  THE  3  VERTICES  OF  THE  TRIANGLE.  * 

************************************************************** 
CALL  TRFTRI(Xq,Yq,Zq,GS,XD,YD,ZD,Cl,C2,C3,C4,C5,X0,Y0) 
************************************************************** 

*  DRAW  THE  CONTOUR.  * 

*******************************************4****************** 

CALL  CONTUR(Xqd)  ,Yq(l)  ,Xq(2)  ,Yq(2)  ,xq(3)  ,Yq(3)  ,F1,F2,F3 
ft  , CA , CB , NC , LC) 

CONTINUE 

****************************************************************** 

*  DRAW  THE  VECTORS  ON  THE  BACK  SIDE.  * 

****************************************************************** 

ICLIP=1 

BANG=20 . 0 
S=8.0 
MNAR=1 
DS= . 003 
XMIN=0 . 0 
XMAX=TP*A 
YMIN-0.0 
YMAX=C 

WRITE(1,*)  ’0  setgray’ 

CALL  CWTE3D (MN,MT,MP,NT,N2T, T2N ,U,V,A,C,KM,XMIN, XMAX , YMIN , YMAX 
ft  ,FU,FV,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,BANG,S,MNAR,DS 
ft  , XCMIN , XCMAX , ICLIP) 

****************************************************************** 

*  DRAW  THE  FRONT  SIDE  OF  THE  CYLINDER.  * 

****************************************************************** 

DO  6  I*ITMAX+1,NT 

N1»N2T(I,1) 

N2=»N2T(I,2) 

N3=N2T(I,3) 

Fl”SqRT(FU(Nl)*FU(Nl)+FV(Nl)*FV(Nl)) 

F2-SQRT(FU(N2) *FU(N2)+FV(N2) *FV(N2) ) 

F3*SqRT(FU(N3) *FU(N3) +FV(N3) *FV(N3) ) 

CALL  MPCPNTOKNl) ,V(N1) ,A,Xq(l) ,Yq(l) ,Zq(l)) 

CALL  MPCPNT(U(N2) ,V(N2) ,A,Xq(2) ,Yq(2) ,Zq(2)) 

CALL  MPCPNT(U(N3) ,V(N3) ,A,Xq(3) ,Yq(3) ,Zq(3)) 

************************************************************** 

*  TRANSFORM  THE  3  VERTICES  OF  THE  TRIANGLE.  * 

************************************************************** 
CALL  TRFTRI(Xq, YQlZq,GS,XD>YD>ZD>Cl ,C2>C3tC4,C5,X0lY0) 
************************************************************** 

*  DRAW  THE  CONTOUR.  * 

************************************************************** 

CALL  CONTUR(Xqd) ,Yq(l) ,Xq(2) ,Yq(2) ,xq(3) ,Yq(3) ,F1,F2,F3 

ft  ,CA,CB,NC,LC) 

CONTINUE 
DO  7  I-l.ITMIN-l 
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Nl*N2T(I,i) 

N2=N2T(I ,2) 

N3=N2T(I ,3) 

F1=SQRT (FU(N1) *FU (Nl) +FV (Nl) *FV(N1) ) 

F2=SQRT (FU(N2) *FU (N2) +FV (N2) *FV (N2) ) 

F3=SQRT (FU(N3) *FU(N3)+FV(N3) *FV(N3) ) 

CALL  MPCPNTCU(Nl) ,V(N1) ,A,XQ(1> ,YQ(1) ,ZQ(1» 

CALL  MPCPNT(U(N2) ,V(N2) ,A,XQ(2) ,YQ(2) ,ZQ(2)) 

CALL  MPCPNT (U (N3) ,V(N3) ,A,XQ(3) ,YQ(3) ,ZQ(3)) 
************************************************************** 

*  TRANSFORM  THE  3  VERTICES  OF  THE  TRIANGLE.  * 

************************************************************** 
CALL  TRFTRI (XQ , YQ , ZQ , GS , XD , YD , ZD , Cl , C2 , C3 , C4 , C5 , XO , YO) 
************************************************************** 

*  DRAW  THE  CONTOUR.  * 

************************************************************** 
CALL  CONTUR(XQCl) ,YQ(1) ,XQ(2) ,YQ(2) ,XQ(3) ,YQ(3) ,F1,F2,F3 

k  ,CA,CB,NC,LC) 

CONTINUE 

****************************************************************** 

*  DRAW  THE  VECTORS  ON  THE  FRONT  SIDE.  * 

****************************************************************** 
ICLIP=2 

XMIN=0 . 0 
XMAX=TP*A 
YMIN=0 . 0 
YMAX=C 
BANG=20 . 0 
S=8.0 
MNAR=1 
DS= . 003 

WRITE(1,*)  >0  setgray ’ 

CALL  CWTE3D (MN,MT,MP,NT,N2T, T2N , U , V , A , C , KM , XMIN , XMAX , YMIN , YMAX 
k  ,FU,FV,GS,XD,YD,ZD,C1 ,C2,C3,C4 ,C5,X0, YO,BANG,S,MNAR,DS 
k  .XCMIN ,XCMAX,ICLIP) 

****************************************************************** 

*  DRAW  THE  LEGEND.  * 

****************************************************************** 

SL-15.0 

SH-30.0 

DS-0.0 

ITYPE-1 

US°409.0 

VS-155.0 

CALL  LEGEND (US, VS, NC.NL.LC, LABEL, SL,SH,DS,ITYPE) 

****************************************************************** 

*  DRAW  THE  PAGE.  * 

****************************************************************** 
WRITE(1,*)  ’ shovpage ’ 

CLOSE(l) 

END 


1  SUBROUTINE  CWTE3D(MN,MT,MP,NT,N2T,T2N,X,Y,A,C, KM, XMIN, XMAX, YMIN 

2  It  ,YMAX,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,BANG,S,MNAR,DS 

3  k  , XCMIN, XCMAX.ICLIP) 

4  C  ****************************************************************** 

5  C  *  THIS  SUBROUTINE  DRAWS  VECTOR  LINES  FOR  A  CIRCULAR  * 

6  C  *  WAVEGUIDE  WITH  TE11  MODE  FIELDS.  * 

7  C  ****************************************************************** 
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8  C 

9  C 

10  C 
u  C 

12  C 

13  C 

14  C 

15  C 

16  C 

17  C 

18  C 

19  C 
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21  C 

22  C 

23  C 

24  C 

25  C 

26  C 
C 
C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 


c 

c 

c 


c 

c 

c 

c 

c 
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*  INPUTS:  * 

*  * 

*  MN  -  MAXIMUM  NUMBER  OF  COORDINATE  POINTS.  * 

*  MT  -  MAXIMUM  NUMBER  OF  TRIANGLES.  * 

*  MP  -  MAXIMUM  NUMBER  OF  TRIANGLES  CONNECTED  TO  A  SINGLE  * 

*  NODE.  * 

*  NT  -  NUMBER  OF  TRIANGLES.  * 

*  N2T(MT,3)  -  NODE  MATRIX  WHERE  FIRST  INDEX  REPRESENTS  * 

*  EACH  TRIANGLE  AND  SECOND  INDEX  REPRESENTS  * 

*  THE  NODE  NUMBERS.  * 

*  T2N(MN,MP)  -  MATRIX  OF  TRIANGLE  TO  NODE  CONNECTIONS  * 

*  WHERE  THE  FIRST  INDEX  IS  THE  NODE  NUMBER  * 

*  AND  THE  SECOND  IS  THE  LOCAL  TRIANGLE  NUMBER.  * 

*  X(MN)  -  COORDINATE  VECTORS  OF  GRID.  * 

*  Y(MN)  * 

*  A  RADIUS  OF  CIRCULAR  WAVEGUIDE  (WAVELENGTHS) .  * 

*  C  LENGTH  OF  CIRCULAR  WAVEGUIDE  (WAVELENGTHS) .  * 

*  XMIN.XMAX  -  DIMENSIONS  OF  UNFOLDED  CIRCULAR  WAVEGUIDE  * 

*  YMIN.YMAX  (WAVELENGTHS).  * 

*  FX(MN)  -  VECTOR  FUNCTION  FIELD  VALUES  AT  EACH  COORDINATE.  * 

*  FY(MN)  * 

*  GS  -  GRAPHICAL  SCALE  CONSTANT.  * 

*  BX.BY  -  GRAPHICAL  OFFSETS.  * 

*  VL  -  SPACING  BETWEEN  ARROWHEADS  IN  REAL  COORDINATES.  * 

*  BANG  -  ARROW  APEX  HALF  ANGLE  IN  DEGREES.  * 

*  S  -  ARROW  HEAD  SIDE  LENGTH  IN  POINT  SIZE.  * 

*  MNAR  -  MAXIMUM  NUMBER  OF  ARROWS  ALLOWED.  * 

*  DS  -  STEP  SIZE.  * 

*  XCMIN.XCMAX  -  HORIZONTAL  CLIPPING  BOUNDARY  (WAVELENGTHS)  * 

*  ICLIP  -  ICLIP-1  MEANS  THAT  ALL  LINES  OUTSIDE  THE  CLIPPING  * 

*  BOUNDARY  ARE  CLIPPED.  ICLIP=2  MEANS  THAT  ALL  * 

*  LINES  INSIDE  THE  CLIPPING  BOUNDARY  ARE  CLIPPED.  * 


****************************************************************** 
REALM  X(MN)  ,Y(MN)  .FX(MN)  ,FY(MN) 

INTEGER  N2T(MT,3) ,T2N(MN,MP) 

PI* . 3141593E+01 
TP-.6283185E+01 
RAD* . 17453293E-01 
K*0 

****************************************************************** 

*  SET  SPACING  PARAMETERS  BASED  ON  CRITICAL  POINT  LOCATIONS.  * 

****************************************************************** 
XWIDTH»PI*A 

TAUX*0 . 84 
NPX-9 

DX»TAUX*XWIDTH/ (NPX-1) 

TAUY-0.9 

NPY-5 

DY« (TAUY*C/KM) / (NPY-1) 

****************************************************************** 

*  SET  GLOBAL  VECTOR  INPUTS.  * 

****************************************************************** 
AH-S*COS (RAD*BANG) 

****************************************************************** 

*  left  REGION  HORIZONTAL  LINES.  * 

****************************************************************** 
XE-0.0 

DO  1  I-O.KM 
YZ— C/(2*KM)+I*C/KM 
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76 
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78 

79 

80 
81 
82 

83  C 

84  C 

85  C 

86 

87 

88 

89 

90 

91 

92  2 

93  1 

94  C 

95  C 

96  C 

97 

98 

99 
100 
101 
102 

103 

104 

105 

106 

107 

108 

109 

110 
111 
112 

113 

114 

115 

116 

117 

118  4 

119  3 

120  C 

121  C 

122  C 

123 

124 

125 


DO  2  J=0,NPY-1 

YE=YZ+ (C/KM) * ( 1 . O-TAUY) /2 . 0+ J*DY 
IF  ((YE  .GT.  DY/2.0)  .AND.  (YE  .LT.  C-DY/2.0))  THEN 
K=K+1 

WRITE (*,*)  ’DRAWING  VECTOR  ’,K 
CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

NDIR=0 
VL=20 . O/GS 

WRITE(1,*)  ’X  begin  direction  1  of  vector  ’  ,K 
CALL  CVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG,S 

it  ,  MNAR ,  DS ,  XCMIN ,  XCMAX ,  ICLIP) 

WRITEd,*)  ’%  end  direction  1  of  vector  ’,K 
NDIR=1 

VL=20 . O/GS-S/GS 

WRITEd,*)  ’*/.  begin  direction  2  of  vector  ’,K 
CALL  CV£C3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,VL,BANG,S,MNAR,DS 

ft  .XCMIN, XCMAX .ICLIP) 

CALL  CVEC3D(XE.YE,ID,NDIR,MN,MT,MP.NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  .YMIN.YMAX.FX.FY.GS.XD.YD.ZD.Cl ,C2,C3,C4,C5,X0,Y0,VL,BANG,S 

ft  , MNAR, DS. XCMIN. XCMAX. ICLIP) 

WRITEd,*)  "/,  end  direction  2  of  vector  ’,K 
ELSE 
END  IF 
CONTINUE 
CONTINUE 

****************************************************************** 

*  LEFT  REGION  VERTICAL  LINES.  * 

****************************************************************** 
DO  3  1=0, KM- 1 

YE=C/(2*KM)+I*C/KM 
DO  4  J=0,NPX-1 
K-K+l 

WRITE (*,*)  ’DRAWING  VECTOR  ’ ,K 

XE=XWIDTH* ( 1 . O-TAUX) /2 . 0+ J*DX 

CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

NDIR-0 

VL-20.0/GS 

WRITEd,*)  ’%  begin  direction  1  of  vector  ’,K 
CALL  CVEC3D (XE , YE,ID,NDIR,MN,MT,MP,NT,N2T, T2N , X , Y , XMIN , XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG,S 

ft  , MNAR, DS, XCMIN, XCMAX, ICLIP) 

WRITEd,*)  ’%  end  direction  1  of  vector  ’,K 
NDIR-1 

VL-20. O/GS-S/GS 

WRITEd,*)  ’X  begin  direction  2  of  vector  ’,K 
CALL  CVEC3D(XE,YE,ID.NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
ft  ,YMIN ,YMAX,FX,FY ,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG,S 

ft  .MNAR.DS, XCMIN, XCMAX, ICLIP) 

WRITEd,*)  ’%  begin  direction  2  of  vector  ’,K 
CONTINUE 
CONTINUE 

e***************************************************************** 

*  CENTER  REGION  HORIZONTAL  LINES.  * 

****************************************************************** 
XE=PI*A 

DO  5  1=0, KM 

YZ=- C/(2*KM)+I*C/KM 
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DO  6  J=0 ,NPY-1 

YE=YZ+ (C/KM) *  < 1 . 0-TAUY) /2.0+J*DY 
IF  ((YE  .GT.  DY/2.0)  .AND.  (YE  .LT.  C-DY/2.0))  THEN 
K-K+l 

WRITEd, *)  'DRAWING  VECTOR  ',K 
CALL  FNDTRI (XE,YE,MN,X,Y,MT,NT,N2T,ID) 

NDIR-0 
VL-20 . O/GS 

WRITEd,*)  *X  begin  direction  i  of  vector  ’ ,K 
CALL  CVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
A  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,Ci,C2,C3,C4,C5,X0,Y0,VL,BANG,S 

A  , MNAR , DS , XCMIN , XCMAX , ICLIP) 

WRITEd,*)  'X  end  direction  1  of  vector  ’,K 
NDIR=1 

VL=20 . O/GS-S/GS 

WRITEd,*)  '7.  begin  direction  2  of  vector  ’  ,K 
CALL  CVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
A  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,Ci,C2,C3,C4,C5,X0,Y0,VL,BANG,S 

A  , MNAR, DS, XCMIN, XCMAX, ICLIP) 

WRITEd,*)  ’%  end  direction  2  of  vector  ',K 
ELSE 
END  IF 
CONTINUE 
CONTINUE 

****************************************************************** 

*  RIGHT  REGION  VERTICAL  LINES.  * 

****************************************************************** 

DO  7  I-O.KM-l 

YE-C/(2*KM)+I*C/KM 
DO  8  J-O.NPX-l 
K-K+l 

WRITE(*,*)  'DRAWING  VECTOR  ' ,K 
XE=PI*A+XWIDTH* ( 1 . O-TAUX) /2 . 0+ J*DX 
CALL  FNDTRI (XE,YE,MN,X,Y,MT>NT,N2T, ID) 

NDIR-0 

VL-20.0/GS 

WRITEd,*)  ’ 7,  begin  direction  1  of  vector  ’  ,K 

CALL  CVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
A  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG,S 

A  , MNAR, DS, XCMIN, XCMAX, ICLIP) 

WRITEd,*)  ’%  end  direction  1  of  vector  ',K 
NDIR-1 

VL-20. O/GS-S/GS 

WRITEd,*)  'X  begin  direction  2  of  vector  '  ,K 
CALL  CVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 
A  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG,S 

A  , MNAR, DS.XCMIN, XCMAX, ICLIP) 

WRITEd,*)  'X  end  direction  2  of  vector  ',K 
CONTINUE 
CONTINUE 

****************************************************************** 

*  RIGHT  REGION  HORIZONTAL  LINES.  * 

****************************************************************** 

XE«TP*A 

DO  9  I-O.KM 

YZ— C/  (2*KM)  +I*C/KM 
DO  10  J-O.HPY-l 

YE-YZ+ (C/KM) * (1 . O-TAUY) /2 . 0+ J*DY 

IF  ((YE  .GT.  DY/2.0)  .AND.  (YE  .LT.  C-DY/2.0))  THEN 


185  K=K+1 

186  WRITE(*,*)  ’DRAWING  VECTOR  ’ ,K 

187  WRITECl,*)  ’*/.  begin  direction  1  of  vector  ’,K 

188  CALL  FNDTRI(XE,YE,MN,X,Y,MT,NT,N2T,ID) 

189  NDIR-0 

190  VL=20 . 0/GS 

191  CALL  CVEC3D(XE,YE,ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 

192  ft  ,YMIN,YMAX,FX,FY,GS ,XD,YD,ZD,C1 ,C2,C3,C4 ,C5,X0,Y0,VL,BANG,S 

193  *  , MNAR , DS , XCMIN , XCMAX , ICLIP) 

194  WRITECl,*)  ’%  end  direction  1  of  vector  ’,K 

195  NDIR-1 

196  VL=20 . O/GS-S/GS 

197  WRITECl,*)  ’%  begin  direction  2  of  vector  ’ ,K 

198  CALL  CVEC3DCXE.YE, ID,NDIR,MN,MT,MP,NT,N2T,T2N,X,Y,XMIN,XMAX 

199  ft  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG,S 

200  ft  ,MNAR,DS, XCMIN, XCMAX, ICLIP) 

201  WRITECl,*)  ’7.  end  direction  2  of  vector  *  ,K 

202  ELSE 

203  END  IF 

204  10  CONTINUE 

205  9  CONTINUE 

206  99  CONTINUE 

207  RETURN 

208  END 
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SUBROUTINE  CVEC3DCXE, YE, ID ,NDIR,MN,MT,MP,NT,N2T,T2N,X ,Y,XMIN ,XMAX 
ft  ,YMIN,YMAX,FX,FY,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0,VL,BANG,S 


ft  , MNAR, DS, XCMIN, XCMAX, ICLIP) 

****************************************************************** 

*  THIS  SUBROUTINE  DRAWS  A  VECTOR  LINE.  * 

****************************************************************** 

*  INPUTS:  * 

*  * 

*  XE.YE  -  FIRST  COORDINATE  OF  VECTOR  LINE.  * 

*  MN  -  MAXIMUM  NUMBER  OF  COORDINATE  POINTS.  * 

*  MT  -  MAXIMUM  NUMBER  OF  TRIANGLES.  * 

*  N2TCMT.3)  -  NODE  MATRIX  WHERE  FIRST  INDEX  REPRESENTS  * 

*  EACH  TRIANGLE  AND  SECOND  INDEX  REPRESENTS  * 

*  THE  NODE  NUMBERS.  * 

*  T2NCMN.MP)  -  MATRIX  OF  TRIANGLE  TO  NODE  CONNECTIONS  * 

*  WHERE  THE  FIRST  INDEX  IS  THE  NODE  NUMBER  * 

*  AND  THE  SECOND  IS  THE  LOCAL  TRIANGLE  NUMBER.  * 

*  XCMN)  -  COORDINATE  VECTORS  OF  GRID.  * 

*  YCMN)  * 

*  FXCMN)  -  VECTOR  FUNCTION  FIELD  VALUES  AT  EACH  COORDINATE.  * 

*  FYCMN)  * 

*  AX.BX  -  GRAPHICAL  SCALE  CONSTANTS.  * 

*  AY, BY  * 

*  VL  -  SPACING  BETWEEN  ARROWHEADS  IN  REAL  COORDINATES.  * 

*  BANG  -  ARROW  APEX  HALF  ANGLE  IN  DEGREES.  * 

*  S  -  ARROW  HEAD  SIDE  LENGTH  IN  POINT  SIZE.  * 

*  MNAR  -  MAXIMUM  NUMBER  OF  ARROWS  ALLOWED.  * 

*  DS  -  STEP  SIZE.  * 

*  * 

*  OUTPUTS:  * 


****************************************************************** 
REAL*4  X(MN) ,Y(MN) ,FX(MN) ,FY(MN) 

INTEGER  N2T(MT,3) ,T2N(MN,MP) 
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35 

36  C 

37  C 

38  C 

39 

40  C 

41  C 

42  C 

43 

44 

45  C 

46  C 

47  C 

48 

49 

50 

51  999 

52 

53  C 

54  C 

55  C 

56  C 

57  C 

58  C 

59 

60 
61 
62 

63 

64 

65 

66  C 

67  C 

68  C 

69  C 

70 

71 

72 

73  C 

74  C 

75  C 

76  C 

77 

78 

79 

80  C 

81  C 

82 

83 

84 

85  C 

86  C 

87  C 

88 

89 

90 

91  C 

92  C 

93  C 


RADIUS=0 .5 

****************************************************************** 

*  STORE  THE  FIRST  TRIANGLE  NUMBER.  * 

****************************************************************** 

IFIRST=ID 

****************************************************************** 

*  STORE  THE  FIRST  POINT.  * 

****************************************************************** 

XFIRST=XE 

YFIRST®YE 

****************************************************************** 

*  BEGIN  THE  VECTOR  SEGMENTS.  * 

****************************************************************** 

K=0 

VSUM=0 . 0 
KAR-0 
CONTINUE 
K=K+1 

VRITEC*,*)  'SEGMENT  NUMBER®  > ,K, '  TRIANGLE  NUMBER®  '.ID 

****************************************************************** 

*  IF  THIS  IS  NOT  THE  FIRST  LINE  THEN  DETERMINE  WHAT  TRIANGLE  * 

*  THE  DRAWN  LINE  CONNECTS  TO  BY  LOOKING  AT  THE  TWO  NODES  NA  AND  * 

*  NB  FORMING  THE  LAST  INTERSECTION .  * 

****************************************************************** 

IF  (K  .GT.  1)  THEN 

IF  (K  .GT.  300)  THEN 
WRITE(* ,*)  'MAX  STEPS  EXCEEDED  ’ 

WRITE(1,*)  ’%  maximum  steps  exceeded’ 

GO  TO  99 

FIT-SF. 

END  IF 

**************************************************************** 

*  SET  THE  BASE  LOCATION  OF  THE  VECTOR  TO  THE  HEAD  LOCATION  OF  * 

*  THE  PREVIOUS  VECTOR.  * 

**************************************************************** 

XA*XF 

YA*YF 

IF  (ID  .EQ.  0)  THEN 

************************************************************** 

*  THERE  IS  NO  NEXT  TRIANGLE  WHICH  MEANS  THE  VECTOR  * 

*  TERMINATES  ON  A  BOUNDARY.  * 

************************************************************** 

WRITE (* , *)  'TERMINATE  ON  BOUNDARY  TRIANGLE’ 

GO  TO  99 

ELSE  IF  (ID  .EQ.  IFIRST)  THEN 
WRITE(*,*)  'BACK  TO  ORIGINAL  TRIANGLE’ 

GO  TO  99 

ET-fiF, 

END  IF 
ELSE 

**************************************************************** 

*  SET  THE  BASE  LOCATION  OF  THE  VECTOR  TO  THE  INITIAL  POINT.  * 
**************************************************************** 
XA-XE 

YA-YE 
END  IF 

****************************************************************** 

*  FIND  THE  VECTOR  FUNCTION  VALUE  AT  THE  BASE  POINT  LOCATION  * 

*  (XA.YA).  * 
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94  C  ****************************************************************** 

95  CALL  VECC0F(MN,HT,ID,X,Y,N2T1FXIFY,A,B,E,C,D,F) 

96  c  ****************************************************************** 

97  C  *  GET  THE  VECTOR  COMPONENTS  AT  THE  POINT  (XA.YA).  * 

98  C  ****************************************************************** 

99  FYA=A*XA+B*YA+E 

100  FXA=C*XA+D*YA+F 

101  FM=SQRT (FXA*FXA+FYA*FYA) 

102  FXN=FXA/FM 

103  FYN=FYA/FM 

104  C  ****************************************************************** 

105  C  *  COMPUTE  THE  LOCATION  (XF.KF)  OF  THE  HEAD  OF  THE  VECTOR.  * 

106  C  ****************************************************************** 

107  IF  (NDIR  .EQ.  0)  THEN 

108  XF=XA+DS*FXN 

109  YF=YA+DS*FYN 

no  ELSE 

111  XF=XA-DS*FXN 

112  YF=YA-DS*FYN 

113  END  IF 

114  C  ****************************************************************** 

US  C  *  IF  THIS  IS  THE  FIRST  TIME  THROUGH  THE  LOOP  THEN  CHKCK  TO  SEE  * 

lie  C  *  IF  THE  ENTIRE  VECTOR  SHOULD  BE  SKIPPED.  * 

117  C  ****************************************************************** 

118  IF  (K  .EQ.  1)  THEN 

119  IF  ((XF  .LT.  XMIN)  .OR.  (XF  .GT.  XMAX)  .OR. 

120  t  (YF  .LT.  YMIN)  .OR.  (YF  .GT.  YMAX))  THEN 

121  WRITE(1  ,*)  ’■/.  vector  skipped’ 

122  GO  TO  104 

123  ELSE 

124  END  IF 

125  ELSE 

126  END  IF 

127  C  ****************************************************************** 

128  C  *  ADJUST  THE  HEAD  POINT  IF  IT  IS  OUTSIDE  THE  GRAPH  BOUNDARY.  * 

129  C  ****************************************************************** 

130  IF  (XF  .LT.  XMIN)  THEN 

131  XF-XMIN 

132  ELSE  IF  (XF  .GT.  XMAX)  THEN 

133  XF=XMAX 

134  ELSE 

135  END  IF 

136  IF  (YF  .LT.  YMIN)  THEN 

137  YF=YMIN 

138  ELSE  IF  (YF  .GT.  YMAX)  THEN 

139  YF-YMAX 

140  ELSE 

141  END  IF 

142  C  ****************************************************************** 

143  C  *  CHECK  THE  BASE  AND  HEAD  POINTS  OF  THE  VECTOR  AGAINST  THE  * 

144  C  *  CLIPPING  BOUNDARY.  * 

145  C  ****************************************************************** 

146  IF  ((XA  .GE.  XCMIN)  .AND.  (XA  .LE.  XCMAX))  THEN 

147  C  **************************************************************** 

148  C  *  THE  BASE  POINT  IS  WITHIN  THE  CLIPPING  BOUNDARY.  * 

149  C  **************************************************************** 

150  IAFLAG-1 

151  ELSE 

152  C  **************************************************************** 
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153  C 

154  C 

155 

156 

157 

158  C 

159  C 

160  C 

161 
162 

163  C 

164  C 

165  C 

166 

167 
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169  C 

170  C 

171 

172 
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174  C 

175  C 

176  C 
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*  THE  BASE  POINT  IS  OUTSIDE  THE  CLIPPING  BOUNDARY.  * 

**************************************************************** 

IAFLAG=2 

END  IF 

IF  ((XF  .GE.  XCMIN)  .AND.  (XF  .LE.  XCMAX))  THEN 

**************************************************************** 

*  THE  HEAD  POINT  IS  WITHIN  OR  ON  THE  CLIPPING  BOUNDARY.  * 

**************************************************************** 

IFFLAG=1 

ELSE 

***********************************************-•  ***4  **********  k* 

*  THE  HEAD  POINT  IS  OUTSIDE  THE  CLIPPING  BOUNDARY.  * 

**************************************************************** 

IFFLAG=2 

END  IF 

****************************************************************** 

*  GET  THE  TRIANGLE  NUMBER  CONTAINING  THE  HEAD  POINT.  * 

****************************************************************** 

IDOLD=ID 

CALL  FDSTRI(XF,YF,MN,X,Y,MT,MP,NT,N2T,T2N,ID0LD,ID) 
write(* ,*)  K , IAFLAG , IFFLAG 

write(l,*)  >7.  K  IAFLAG  IFFLAG  *  ,K, IAFLAG, IFFLAG 

****************************************************************** 

*  HANDLE  EACH  CASE  FOR  DRAWING  OR  NOT  DRAWING  A  VECTOR.  * 

****************************************************************** 

IF  (((IAFLAG  .Eq.  1)  .AND.  (IFFLAG  .EQ.  1)  .AND.  (ICLIP  .Eq.  D) 

ft  .OR.  ((IAFLAG  .Eq.  2)  .AND.  (IFFLAG  .Eq.  2) 
ft  .AND.  (ICLIP  .Eq.  2)))  THEN 

**************************************************************** 

*  THE  BASE  AND  HEAD  ARE  BOTH  VISIBLE.  * 

**************************************************************** 

IF  (K  .Eq.  1)  THEN 

CALL  MPCPNT (XA , YA .RADIUS , XAT , YAT , ZAT) 

CALL  TRFPNT(XAT,YAT,ZAT,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0) 

WRITE (1,100)  XAT .YAT,'  moveto' 

ELSE 

CALL  MPCPNT(XF,YF,RADIUS,XFT,YFT,ZFr 

CALL  TRFPNT(XFT,YFT,ZFT,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0) 
WRITE(l.lOO)  XFT.YFT, ’  lineto’ 

END  IF 

**************************************************************** 

*  DRAW  ARROW  OR  ARROWS  IF  APPROPRIATE.  * 

**************************************************************** 

DAR-SqRT ( (XA-XF) * (XA-XF) + ( YA-YF) * ( YA-YF) ) 

IF  (DAR  .GT.  0.0)  THEN 
IF  (NDIR  .Eq.  0)  THEN 

CALL  CARR3D(MNAR,VL,BANG,o,XA,YA,XF,YF,FXN,FYN,VSUM,KAR 
ft  ,GS, XD, YD, ZD, Cl, C2,C3,C4,C5,XO,YO, IAFLAG, IFFLAG, ICLIP) 

ELSE 

CALL  CARR3D (MNAR , VL , BANG ,S,XF,YF,XA,YA, FXN , FYN , VSUM , KAR 
ft  ,GS, XD,YD, ZD, Cl, C2,C3,C4,C5,X0,Y0, IAFLAG, IFFLAG, ICLIP) 

END  IF 
ELSE 
END  IF 

ELSE  IF  (  ((IAFLAG  .Eq.  1)  .AND.  (IFFLAG  .Eq.  2)  .AND. 
ft  (ICLiP  .Eq.  1)  .AND.  (K  .NE.  1))  .OR. 

ft  ((IAFLAG  .Eq.  2)  .AND.  (IFFLAG  .Eq.  1)  .AND. 

ft  (ICLIP  .Eq.  2)  .AND.  (K  .NE.  1))  )  THEN 

**************************************************************** 
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*  THE  BASE  IS  VISIBLE  AND  THE  HEAD  IS  NOT  VISIBLE.  THIS  * 

*  OCCURS  AT  A  CLIPPING  BOUNDARY.  * 

**************************************************************** 
CALL  MPCPNT(XF,YF, RADIUS, XFT, YFT, ZFT) 

CALL  TRFPNT ( XFT , YFT , ZFT , GS , XD , YD , ZD , Cl , C2 , C3 , C4 , C5 , XO , YO ) 
WRITE(l.lOl)  XFT. YFT. ’  lineto  stroke’ 

WRITE (1,*)  ’7,  termined  at  clipping  boundary’ 

ELSE  IF  (((IAFLAG  .EQ.  2)  .AND.  (IFFLAG  .EQ.  1)  .AND. 
ft  (ICLIP  .EQ.  D)  .OR.  ((IAFLAG  .EQ.  1)  .AND. 

k  (IFFLAG  .EQ.  2)  .AND. (ICLIP  .EQ.  2)))  THEN 

CALL  MPCPNT(XF,YF, RADIUS. XFT, YFT, ZFT) 

CALL  TRFPNT (XFT , YFT , ZFT , GS , XD , YD , ZD , Cl , C2 , C3 , C4 , C5 , XO , YO) 
WRITE(1,*)  ’%  start  of  visible  vector  section’ 

WRITE(1,*)  ’  newpath’ 

WRITE (1,100)  XFT, YFT,’  moveto’ 

ELSE 

**************************************************************** 

*  BOTH  POINTS  ARE  HIDDEN.  JUST  ACCUMULATE  THE  VECTOR  LENGTH.  * 
**************************************************************** 
DAR=SQRT ( (XA-XF) * (XA-XF) + (YA-YF) * (YA-YF) ) 

IF  (DAR  .GT.  0.0)  THEN 
IF  (NDIR  .EQ.  0)  THEN 

CALL  CARR3D (MNAR,VL,BANG,S,XA,YA,XF,YF,FXN,FYN,VSUM,KAR 
k  , GS, XD, YD, ZD, Cl, C2,C3,C4,C5,X0,Y0, IAFLAG, IFFLAG, ICLIP) 

FT.qp 

CALL  CARR3D(MNAR,VL,BANG,S,XF,YF,XA,YA,FXN,FYN,VSUM,KAR 
ft  , GS.XD, YD, ZD, Cl, C2,C3,C4,C5,X0,Y0, IAFLAG, IFFLAG, ICLIP) 

END  IF 

ELSE 
END  IF 
END  IF 

****************************************************************** 

*  STOP  IF  VECTOR  MAGNITUDE  DROPS  BELOW  TOLERANCE.  * 

****************************************************************** 
IF  (FM  .LT.  .001)  THEN 

WRITE(1,*)  ’7.  magnitude  below  tolerance’ 

GO  TO  99 
ELSE 
END  IF 
GO  TO  999 

********************************** ******************************** 

*  STOP.  * 

****************************************************************** 
CONTINUE 

IF  (  (((IAFLAG  .EQ.  1) .OR. (IFFLAG  .EQ.  1))  .AND.  (ICLIP  .EQ.  1)) 
ft  .OR. 

ft  (((IAFLAG  .EQ.  2)  .OR.  (IFFLAG  .EQ.  2))  .AND.  (ICLIP  .EQ.  2))) 
ft  THEN 

WRITE (1,*)  ’stroke’ 

ELSE 
END  IF 

F0RMAT(2(F6.2,1X),A7) 

F0RMAT(2(F6.2,1X) ,A14) 

CONTINUE 

ID=IFIRST 

RETURN 

END 


1  SUBROUTINE  CARR3D(MNAP.,VL,BANG,S,XF,YF,XA,YA,FXN,FYN,VSUM,KAR 


99 


2 

3  C 

4  C 

5  C 

6  C 

7  C 

8  C 

9  C 

10  C 
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16  C 

17  C 

18  C 

19  C 

20 
21 
22 

23 

24 

25 

26 

27 

28  C 

29  C 
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31  C 

32 

33 

34 
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37  C 

38 

39 

40 

41 

42 

43 

44 

45 
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47  C 
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49 

50 

51  C 
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58  C 
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k  , GS , XD , YD , ZD ,C1 , C2 , C3 , C4 , C5 ,X0 , YO , IAFLAG , IFFLAG , ICLIP ) 

♦♦a*************************************************************** 

*  THIS  SUBROUTINE  CONTROLS  THE  DRAWING  OF  ARROWHEADS  ON  A  LINE.  * 
****************************************************************** 


*  INPUTS :  * 

♦  * 

*  MNAR  -  MAXIMUM  NUMBER  OF  ARROWS  ALLOWED.  * 

*  VL  -  SPACING  BETWEEN  ARROWHEADS  IN  REAL  COORDINATES.  * 

*  BANG  -  ARROW  APEX  HALF  ANGLE  IN  DEGREES.  * 

*  S  -  ARROW  HEAD  SIDE  LENGTH  IN  POINT  SIZE.  * 

*  XA.YA  -  BASE  OF  ARROW.  * 

*  XF.YF  -  TIP  OF  ARROW.  * 

*  FXN.FYN  -  NORMALIZED  VECTOR  FUNCTION  VALUES.  * 

*  VSUM  -  ACCUMULATED  LINE  LENGTH.  * 

*  KAR  -  NUMBER  OF  ARROWS  DRAWN  SO  FAR.  * 

*  AX.BX  -  GRAPHICAL  SCALE  CONSTANTS.  * 

*  AY, BY  * 


****************************************************************** 
D=SQRT ( (XA-XF) * (XA-XF) + (YA- YF) * ( YA-YF) ) 

STEP=VSUM+D 
IF  (STEP  .GT.  VL)  THEN 
KAR=KAR+1 

IF  (KAR  .GT.  MNAR)  THEN 
GO  TO  2 
ELSE 
END  IF 

**************************************************************** 

*  THE  NEXT  LINE  SEGMENT  IS  LONGER  THAN  THE  ARROW  SPACING.  * 

*  SO  AN  ARROW  SHOULD  BE  DRAWN.  * 

**************************************************************** 
RAT= (VL-VSUM) /D 

XFW=XA+RAT* (XF-XA) 

YFW-YA+RAT* (YF-YA) 

**************************************************************** 

*  DRAW  THE  ARROW.  * 

**************************************************************** 
IF  (  ((IAFLAG  .EQ.  1) .AND. (IFFLAG  .EQ.  1)  .AND.  (ICLIP  .EQ.  1)) 

k  .OR. 

k  ((IAFLAG  .EQ.  2)  .AND.  (IFFLAG  .Eq.  2)  .AND.  (ICLIP  .EQ.  2))) 
k  THEN 

CALL  CAHD3D(BANG,GS,S,XFW,YFW,FXN,FYN,XD,YD,ZD,C1,C2 
k  ,C3,C4,C5,X0,Y0) 

F.T.RE 
END  IF 

**************************************************************** 

*  COMPUTE  THE  AMOUNT  LEFT  OVER  AFTER  THE  ARROW  IS  DRAWN.  * 

**************************************************************** 
DLT=SQRT ( (XF-XFW) * (XF-XFW) + ( YF-YFW) * (YF-YFW) ) 

IF  (DLT  .LT.  VL)  THEN 

************************************************************** 

*  NO  MORE  ARROWS  ARE  DRAWN  ON  THIS  SEGMENT.  * 

************************************************************** 
VSUM'DLT 

ELSE 

************************************************************** 

*  MORE  THAN  ONE  ARROW  IS  DRAWN  ON  THIS  SEGMENT.  * 

************************************************************** 
NAR-DLT/VL 

DO  1  1*1, NAR 
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62 

63 

64 

65 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 

77 

78 

79 

80 

81  C 

82  C 

83  C 

84  C 


KAR=KAR+1 

IF  (KAR  .GT.  MNAR)  THEN 
GO  TO  2 

ET.SF. 

END  IF 

RAT= (VL-VSUM+I *VL) /D 
XFW=XA+RAT* (XF-XA) 

YFW=YA+RAT* (YF-YA) 

IF  (  ((IAFLAG  .EQ.  1) .AND. (IFFLAG  .EQ.  1)  .AND.  (ICLIP  .Eq.  1)) 

4  .OR. 

4  ((IAFLAG  .Eq.  2)  .AND.  (IFFLAG  .Eq.  2)  .AND.  (ICLIP  .Eq.  2))) 
4  THEN 

CALL  CAHD3D (BANG,GS,S,XFW,YFW,FXN,FYN,XD,YD,ZD,C1 ,C2 
4  ,C3,C4,C5,X0,Y0) 

FTRF 
END  IF 
CONTINUE 

VSUM=SqRT( (XF-XFW) * (XF-XFW) + (YF-YFW) * (YF-YFW) ) 

END  IF 
ELSE 

**************************************************************** 

*  THE  LINE  LENGTH  PLUS  THE  ACCUMULATED  DISTANCE  IS  STILL  LESS  * 

*  THAN  THE  ARROW  SPACING.  NO  ARROW  SHOULD  BE  DRAWN  JUST  * 

*  ACCUMULATE  THE  DISTANCE.  * 


85  C  **************************************************************** 


86  VSUM=VSUM+D 

87  END  IF 

88  2  CONTINUE 

89  RETURN 

90  END 


1  SUBROUTINE  CAHD3D(BANG,GS,S,X2,Y2,FXN,FYN,XD,YD,ZD,C1,C2 

2  4,C3,C4,C5,X0,Y0) 

3  C  ****************************************************************** 


4  C  *  THIS  SUBROUTINE  DRAWS  A  ARROW  FROM  (XI, Yl)  TO  (X2.Y2).  * 

5  C  ****************************************************************** 

6  C  *  INPUTS:  * 

7  C  *  * 

8  C  *  BANG  -  ARROW  APEX  HALF  ANGLE  IN  DEGREES.  * 

9  C  *  S  -  ARROWHEAD  SIDE  LENGTH.  * 

10  C  *  X2.Y2  -  TIP  OF  ARROW.  * 

11  C  *  FXN.FYN  -  NORMALIZED  VECTOR  FUNCTION  VALUES.  * 


12  C  ****************************************************************** 

13  RAD* . 17453293E-01 

14  X1=X2-FXN 

is  Y1-Y2-FYN 

16  D*SqRT ( (X2-X1) * (X2-X1) + ( Y2-Y 1 ) * (Y2-Y1) ) 

17  A*1 . 0-S/(GS*D) 

18  X3*X1+A* (X2-X1) 

19  Y3*Y1+A*(Y2-Y1) 

20  C  ****************************************************************** 

21  C  *  TRANSLATE  THE  ORIGIN  TO  (X2,Y2)  AND  ROTATE  (X3.Y3)  PLUS  AND  * 

22  C  *  MINUS  BANG  DEGREES  TO  GENERATE  THE  VERTICES  OF  THE  ARROW.  * 

23  C  ****************************************************************** 

24  XA=X3-X2 

25  YA-Y3-Y2 

26  ARG»RAD*BANG 

27  CA-COS(ARG) 

28  SA-SIN(ARG) 
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c 

c 

C 

C 

C 

C 

C 

C 
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54 

55 

56 

57 


XCA«XA*CA 
XSA=XA*SA 
YCA=YA*CA 
YSA=YA*SA 
X4=X2+XCA-YSA 
Y4=Y2+XSA+YCA 
X5=X2+XCA+YSA 
Y5»Y2-XSA+YCA 
X6=(X4+X5)/2.0 
Y6= (Y4+Y5)/2.0 
WRITEC1,*)  XI, Yl, *  moveto’ 

WRITE(1,*)  X6.Y6,'  lineto  stroke' 

****************************************************************** 

*  TRANSLATE  THE  ORIGIN  TO  (X2.Y2)  AND  ROTATE  (X3.Y3)  PLUS  AND  * 

*  MINUS  BANG  DEGREES  TO  GENERATE  THE  VERTICES  OF  THE  ARROW  * 
****************************************************************** 
RADIUS=0 . 5 

CALL  MPCPNTCX2.Y2, RADIUS, X2T.Y2T.Z2T) 

CALL  MPCPNT (X4.Y4, RADIUS, X4T.Y4T.Z4T) 

CALL  MPCPNT (X5.Y5, RADIUS, X5T.Y5T.ZST) 

CALL  TRFPNT(X2T,Y2T,Z2T,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0) 

CALL  TRFPNT(X4T,Y4T,Z4T,GS,XD,YD,ZD,C1,C2,C3,C4,C5,X0,Y0) 

CALL  TRFPNT(X5T,Y5T,Z5T,GS,XD,YD,ZD,Ci,C2,C3,C4,C5,X0,Y0) 

WRITE (1,*)  ’gsave  newpath’ 

WRITE(1,*)  X2T.Y2T, *  moveto  ’,X4T,Y4T,’  lineto  ’ 

&  ,X5T,Y5T, '  lineto' 

WRITEd,*)  ’ closepath  0  setgray  fill  stroke  grestore’ 

RETURN 

END 


1  SUBROUTINE  MPCPNT(U,V,A,X,Y,Z) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  MAPS  A  POINT  FROM  THE  UNNFOLDED  CIRCULAR  * 

4  C  *  WAVEGUIDE  (U,V)  SPACE  TO  THE  (X,Y,Z)  FOLDED  WAVEGUIDE  SPACE.  * 

5  C  ****************************************************************** 


6  C  *  INPUTS:  * 

7  C  *  * 

8  C  *  U,V  -  COORDINATES  OF  THE  UNFOLDED  WAVEGUIDE  POINT.  * 

9  C  *  A  -  RADIUS  OF  CIRCULAR  WAVEGUIDE  (WAVELENGTHS) .  * 

10  C  *  * 

11  C  *  OUTPUTS:  * 

12  C  *  * 

13  C  *  X,Y,Z  -  COORDINATES  OF  MAPPED  POINT.  * 


14  C  ****************************************************************** 

15  X«A*COS(U/A) 

is  Y«A*SIN(U/A) 

17  Z»V 

18  RETURN 

19  END 
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1  SUBROUTINE  TRFTRI(XfY,Z,GS,XC,YC,ZC,Cl,C2,C3,C4,C5,X0,Y0) 

2  C  ****************************************************************** 


3  C  *  THIS  SUBROUTINE  TRANSFORMS  EACH  POINT  OF  A  TRIANGLE.  * 

4  C  ****************************************************************** 

5  C  *  INPUTS:  * 

6  C  *  * 

7  C  *  X(3)  COORDINATES  OF  EACH  VERTEX  OF  A  TRIANGLE.  * 

8  C  *  Y(3)  * 

9  C  *  Z(3)  * 

10  C  *  GS  -  GRAPH  SCALE  FACTOR.  * 

11  C  *  XC,YC,ZC  -  CENTER  OF  ROTATION.  * 

12  C  *  C1.C2.C3  -  ROTATION  MATRIX  COEFFICIENTS.  * 

13  C  *  C4,C5  * 

14  C  *  XO.VO  -  HORIZONTAL  AND  VERTICAL  DEVICE  OFFSETS.  * 

15  C  *  * 

16  C  *  OUTPUT:  * 

17  C  *  * 

is  C  *  X(3)  -  TRANSFORMED  COORDINATES  OF  EACH  CORNER  OF  THE  * 

19  C  *  Y(3)  PROJECTED  ONTO  THE  X-Y  PLANE.  * 


20  C  ****************************************************************** 

21  REAL*4  X(3),Y(3),Z(3) 

22  DO  1  1-1,3 

23  CALL  SCALE(GS.XCI) ,Y(I) ,Z(I)) 

24  CALL  T3LATE(X(I) ,Y(I) ,Z(I) ,XC,YC,ZC) 

25  CALL  ROTATE(X(I) ,Y(I) ,Z(I) ,C1,C2,C3,C4,C5) 

26  CALL  T3LATE(X(I) ,Y(I) ,Z(I) .-XC.-YC.-ZC) 

27  CALL  T2LATE(X(I) ,Y(I) ,XO,YO) 

28  1  CONTINUE 

29  RETURN 

30  END 

1  SUBROUTINE  TRFPNT(X,Y,Z,GS,XC,YC,ZC,Cl,C2,C3fC4,C5,X0,Y0) 

2  C  ****************************************************************** 


3  C  *  THIS  SUBROUTINE  TRANSFORMS  A  POINT.  * 

4  C  ****************************************************************** 

5  C  *  INPUTS:  * 

6  C  *  * 

7  C  *  X,Y,Z  -  COORDINATES  OF  A  POINT.  * 

8  C  *  GS  -  GRAPH  SCALE  FACTOR.  * 

9  C  *  XC.YC.ZC  -  CENTER  OF  ROTATION.  * 

10  C  *  C1.C2.C3  -  ROTATION  MATRIX  COEFFICIENTS.  * 

11  C  *  C4.C5  * 

12  C  *  XO.VO  -  HORIZONTAL  AND  VERTICAL  DEVICE  OFFSETS.  * 

13  C  *  * 

14  C  *  OUTPUT:  * 

is  C  *  * 

16  C  *  X.Y  -  TRANSFORMED  COORDINATES  OF  EACH  CORNER  OF  THE  * 

17  C  *  PROJECTED  ONTO  THE  X-Y  PLANE.  * 


18  C  ****************************************************************** 

19  CALL  SCALE(GS,X,Y,Z) 

20  CALL  T3LATE(X,Y,Z, XC.YC.ZC) 

21  CALL  ROTATE (X,Y,Z, Cl, C2,C3,C4,C5) 

22  CALL  T3LATE (X , Y , Z , -XC , -YC , -ZC) 

23  CALL  T2LATE(X,Y,X0,Y0) 

24  RETURN 

25  END 

1  SUBROUTINE  T3LATE(X,Y,Z, XC.YC.ZC) 

2  C  ****************************************************************** 
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3  C  *  THIS  SUBROUTINE  TRANSLATES  THE  ORIGIN  TO  THE  POINT  (XC,YC,ZC).  * 

4  C  ****************************************************************** 

s  x*x-xc 

6  Y=Y-YC 

7  Z*Z-ZC 

8  RETURN 

9  END 

1  SUBROUTINE  T2LATE(X,Y,XC,YC) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  TRANSLATES  THE  POINT  (X,Y)  TO  THE  POINT  * 

4  C  *  TO  THE  POINT  (XC.YC).  * 

5  C  ****************************************************************** 

6  X=X+XC 

7  Y=Y+YC 

s  RETURN 

9  END 

1  SUBROUTINE  SCALE (GS,X,Y,Z) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  SCALES  A  POINT.  * 

4  C  ****************************************************************** 

5  X=GS*X 

6  Y=GS*Y 

7  Z*GS*Z 

8  RETURN 

9  END 

1  SUBROUTINE  RC0EFF(RP,RT,C1,C2,C3,C4,CS) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  COMPUTES  THE  ROTATION  COEFFICIENTS.  * 

4  C  ****************************************************************** 

5  CP=COS (RP) 

6  SP-SIN(RP) 

7  C1*CP 

8  C2— SP 

9  CT-COS(RT) 

io  C3»CT*SP 

n  C4*CT*CP 

12  C5-SINCRT) 

13  RETURN 

14  END 

1  SUBROUTINE  R0TATE(X,Y,Z,C1,C2,C3,C4,C5) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  ROTATES  POINTS  IN  THREE  DIMENSIONS  AND  TAKES  * 

4  C  *  THE  PARALLEL  PROJECTION  ONTO  THE  X-Y  PLANE.  * 

5  C  ****************************************************************** 

«  XR-X 

7  YR-Y 

8  X«C1*XR+C2*YR 

9  Y*C3*XR+C4*YR+C5*Z 

10  RETURN 

11  END 
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1  SUBROUTINE  VECC0F(MN,MT,ID,X,Y,XA,YA,N2T,FX,FY,A,B,E,C,D,F) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  RETURNS  THE  VECTOR  FUNCTION  COEFFICIENTS  FOR  * 

4  C  *  THE  IDTH  TRIANGLE.  * 

5  C  ****************************************************************** 

6  REAL*4  X(MN) ,Y(MN) ,FX(MN) ,FY(MN) 

r  INTEGER  N2T(MT,3) 

8  X1=X(N2T(ID,1)) 

9  Y1=Y(N2T(ID,1)) 

10  X2=X (N2T ( ID , 2) ) 

11  Y2=Y(N2T(ID,2)) 

12  X3=X (N2T ( ID , 3) ) 

13  Y3=Y(N2T(ID,3)) 

14  FX1=>FX(N2T(ID,  1)) 

15  FX2=FX(N2T(ID,2)) 

16  FX3=FX(N2T(ID,3)) 

17  FY1=FY(N2T(ID, 1) ) 

is  FY2”FY(N2T(ID,2)) 

19  FY3=FY (N2T ( ID , 3) ) 

20  DEN=X1*Y2-X1*Y3-X2*Y1+X3*Y1+X2*Y3-X3*Y2 

21  A= (FY1* (Y2-Y3) -FY2* (Y1-Y3) +FY3* (Y1-Y2) ) /DEN 

22  B* (-FY1* (X2-X3) +FY2* (X1-X3) -FY3* (X1-X2) ) /DEN 

23  E=(FY1*(X2*Y3-X3*Y2)-FY2*(X1*Y3-X3*Y1)+FY3*(X1*Y2-X2*Y1))/DEN 

24  C= (FX1* (Y2-Y3) -FX2* (Y1-Y3) +FX3* (Y1-Y2) ) /DEN 

25  D= (-FX1* (X2-X3) +FX2* (X1-X3) -FX3* (X1-X2) ) /DEN 

26  F- (FX1* (X2*Y3-X3*Y2) -FX2* (X1*Y3-X3*Y1)+FX3* (X1*Y2-X2*Y1) ) /DEN 

27  RETURN 

28  END 

1  SUBROUTINE  FNDTRI(XA,YA,MN,X,Y,MT,NT,N2T,ID) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  SORTS  THROUGH  THE  TRIANGLES  AND  FINDS  THE  ONE  * 

4  C  *  CONTAINING  THE  POINT  XA.YA.  * 

5  C  ****************************************************************** 

6  REAL*4  X(MN) ,Y(MN) 

7  INTEGER  N2T(HT,3) 

8  ID*0 

9  DO  1  I-l.NT 

10  X1«X(N2T(I,1)) 

11  Y1=Y(N2T(I,1)) 

12  X2*X(N2T(I,2)) 

13  Y2=Y(N2T(I,2)) 

14  X3*X(N2T(I,3)) 

is  Y3*Y(N2T(I,3)) 

16  CALL  PINTRI(XA,YA,X1,Y1,X2,Y2,X3>Y3,IFLAG) 

17  IF  (IFLAG  .EQ.  1)  THEN 

18  ID»  I 

19  ELSE 

20  END  IF 

21  1  CONTINUE 

22  C  VRITE(*,*)  XA.YA,'  IN  TRIANGLE  ’.ID 

23  RETURN 

24  END 

1  SUBROUTINE  FDSTRI(XA,YA,MN,X,Y,MT,MP,NT>N2T,T2N,IA,ID) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  SORTS  THROUGH  THE  TRIANGLES  CONNECTED  TO  THE  * 

4  C  *  THREE  NODES  OF  THE  IATH  TRIANGLE  TO  FIND  THE  ONE  CONTAINING  * 

5  C  *  THE  POINT  XA.YA.  * 
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6  C  ****************************************************************** 


7 

REAL*4  X(MN) ,Y(MN) 

8 

INTEGER  N2T(MT,3),T2N(MiN,MP) 

9 

ID-0 

10  C 

****************************************************************** 

11  C 

*  CHECK  TO  SEE  IF  THE  POINT  IS  IN  THE  IATH  TRIANGLE. 

* 

12  C 

****************************************************************** 

13 

DO  2  1=1,3 

14 

N*N2T(IA,I) 

15  C 

WRITE(*,*)  ’NODE  ’,N,’  CONNECTED  TO  TRIANGLE  ’ ,IA 

16 

DO  3  J=1 ,MP 

17 

IF  (T2N(N, J)  .NE.  0)  THEN 

18  C 

WRITE(*,*)  ’TRIANGLE  NUMBER  ’ ,N, J.T2NCN, J) 

19 

X1*X(N2T(T2N(N, J) ,1)) 

20 

Y1*Y(N2T(T2N(N, J) ,1)) 

21 

X2=X (N2T (T2N (N , J) ,2)) 

22 

Y2=Y(N2T(T2N(N, J) ,2)) 

23 

X3*X(N2T(T2N(N, J) ,3)) 

24 

Y3=Y(N2T(T2N(N, J) ,3)) 

25 

CALL  PINTRI(XA,YA,X1,Y1,X2>Y2,X3, Y3, IFLAG) 

26 

IF  (IFLAG  .EQ.  1)  THEN 

27 

ID=T2N(N,J) 

28 

GO  TO  99 

29 

ELSE 

30 

END  IF 

31 

ELSE 

32 

END  IF 

33 

3 

CONTINUE 

34 

2 

CONTINUE 

35  99 

CONTINUE 

36 

RETURN 

37 

END 

1  SUBROUTINE  PINTRKX.Y, XI, Yi,X2,Y2,X3,Y3, IFLAG) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  DETERMINES  WHETHER  THE  POINT  (X,Y)  LIES  INSIDE  * 

4  C  *  THE  TRIANGLE  DETERMINED  BY  THE  POINTS  (XI, Yl) ,  (X2.Y2)  AND  * 

5  C  *  (X3.Y3).  * 

6  C  ****************************************************************** 

7  I FLAG-0 

8  C  ****************************************************************** 

9  C  *  CHECK  TO  SEE  IF  THE  POINT  IS  IN  THE  SAME  HALF  PLANE  AS  POINT  * 

10  C  *  (Xl.Yl).  * 

11  C  ****************************************************************** 

12  CALL  HPLANE(X1,Y1,X2,Y2,X3,Y3,I) 

13  CALL  HPLANE(X,Y,X2,Y2,X3,Y3,J) 

14  IF  ((I  .Eq.  J)  .OR.  (J  .EQ.  0))  THEN 

15  C  **************************************************************** 

16  C  *  CHECK  TO  SEE  IF  THE  POINT  (X,Y)  IS  IN  THE  SAME  HALF  PLANE  AS  * 

17  C  *  POINT  (X2.Y2).  * 

18  C  **************************************************************** 

19  CALL  HPLANE(X2,Y2,X3,Y3,X1,Y1,I) 

20  CALL  HPLANE(X,Y,X3,Y3,X1,Y1,J) 

21  IF  ((I  .EQ.  J)  .OR.  (J  .EQ.  0))  THEN 

22  C  ************************************************************** 

23  C  *  CHECK  TO  SEE  IF  THE  POINT  (X,Y>  IS  IN  THE  SAME  HALF  PLANE  * 

24  C  *  AS  POINT  (X3,Y3).  * 

25  C  ************************************************************** 

26  CALL  HPLANE(X3,Y3,X1,Y1,X2,Y2,I) 
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27  CALL  HPLANE(X,Y,X1,Y1,X2,Y2,J) 

28  IF  ((I  .EQ.  J)  .OR.  (J  .EQ.  0))  THEN 

29  IFLAG=1 

30  ELSE 

31  END  IF 

32  ELSE 

33  END  IF 

34  ELSE 

35  END  IF 

36  RETURN 

37  END 

1  SUBROUTINE  HPLANE(X,Y,X1,Y1,X2,Y2,I) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  DETERMINES  WHETHER  THE  POINT  (X,Y)  LIES  ON  * 

4  C  *  ABOVE  OR  BELOW  THE  LINE  DETERMINED  BY  THE  POINTS  (XI, Yl)  AND  * 

5  C  *  (X2.Y2).  * 

6  C  ****************************************************************** 

7  REAL*8  D 

8  D=(X-X1)*(Y2-Y1)-(X2-X1)*(Y-Y1) 

e  IF  (D  .LT.  0.0)  THEN 

10  I=-l 

11  ELSE  IF  (D  .GT.  0.0)  THEN 

12  1=1 

13  ELSE 

14  1=0 

is  END  IF 

16  RETURN 

17  END 


1 

2  C 

3  C 

4  C 

5  C 

6  C 

7  C 

8  C 

9  C 
10 

11 

12  C 

13  C 

14  C 

15 

16 

17 

18  C 

19  C 

20  C 

21 
22 

23 

24 

25 

26  C 

27  C 

28  C 

29 


SUBROUTINE  C0NTUR(X1,Y1,X2,Y2,X3,Y3,Z1,Z2,Z3,CA,CB,NC,LC) 
****************************************************************** 

*  THIS  SUBROUTINE  DRAWS  CONTOURS  ON  A  SINGLE  TRIANGLE.  * 

****************************************************************** 

*  INPUTS:  * 

* 

*  (XI, Yl),  (X2.Y2) ,  (X3,Y3)  -  TRIANGLE  VERTICES.  * 

*  Z1.Z2.Z3  -  TRIANGLE  VERTEX  FUNCTION  VALUES.  * 

****************************************************************** 
REAL  CA(NC) ,CB(NC) 

INTEGER  LC(NC) 

****************************************************************** 

*  LOOP  THROUGH  EACH  CONTOUR  PAIR.  * 

****************************************************************** 
DO  1  1=1, NC 

CMIN-CA(I) 

CMAX-CB(I) 

**************************************************************** 

*  3  POINTS  WITHIN  THE  CONTOUR  RANGE.  * 

**************************************************************** 

IF  ((Zl  .GE.  CHIN)  .AND.  (Z1  .LE.  CMAX)  .AND. 

4  (Z2  .GE.  CMIN)  .AND.  (Z2  .LE.  CMAX)  .AND. 

4  (Z3  .GE.  CMIN)  .AND.  (Z3  .LE.  CMAX))  THEN 

CALL  SETCOL(LC(I)) 

CALL  FILTRI (XI , Yl , X2 , Y2 , X3 , Y3) 

**************************************************************** 

*  VERTEX  1  AND  2  ARE  IN  RANGE  AND  VERTEX  3  IS  OUT  OF  RANGE.  * 
**************************************************************** 

ELSE  IF  (((Z3  .LT.  CMIN)  .OR.  (Z3  .GT.  CMAX)). AND. 
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30 


C 

C 

c 


c 

c 

c 


c 

c 

c 

c 


87  C 

88  C 


it  (Zl  .GE.  CHIN)  .AND.  (Z1  .LE.  CMAX)  .AND. 

ft  (Z2  .GE.  CMIN)  .AND.  (Z2  .LE.  CMAX))  THEN 

IF  (Z3  .LT.  CMIN)  THEN 
CV-CMIN 
ELSE 
CV=CMAX 
END  IF 

CALL  CR0SS(CV,X3,Y3,Z3,X1,Y1,Z1,XL,YL) 

CALL  CR0SS(CV,X2,Y2,Z2,X3,Y3,Z3,XQ,YQ) 

CALL  SETCOL(LC(I)) 

CALL  FILQUD(XL,YL,X1,Y1,X2,Y2,XQ,YQ) 
**************************************************************** 

*  VERTEX  2  AND  3  ARE  IN  RANGE  AND  VERTEX  1  IS  OUT  OF  RANGE.  * 
**************************************************************** 
ELSE  IF  (<(Z1  .LT.  CMIN)  .OR.  (Z1  .GT.  CMAX)). AND. 

k  (Z2  .GE.  CMIN)  .AND.  (Z2  .LE.  CMAX)  .AND. 

&  (Z3  .GE.  CMIN)  .AND.  (Z3  .LE.  CMAX))  THEN 

IF  (Z1  .LT.  CMIN)  THEN 
CV=CMIN 
ELSE 
CV-CMAX 
END  IF 

CALL  CR0SS(CV,Xi,Yl.ZltX2,Y2,Z2,XL,YL) 

CALL  CR0SS(CV,X3,Y3,Z3,X1,Y1,Z1,XQ,YQ) 

CALL  SETCOL(LC(I)) 

CALL  FILQUD(XL,YL,X2,Y2,X3,Y3,XQ,YQ) 
**************************************************************** 

*  VERTEX  3  AND  1  ARE  IN  RANGE  AND  VERTEX  2  IS  OUT  OF  RANGE.  * 
**************************************************************** 
ELSE  IF  (<<Z2  .LT.  CMIN)  .OR.  (Z2  .GT.  CMAX)). AND. 

k  (Z1  .GE.  CMIN)  .AND.  (Zl  .LE.  CMAX)  .AND. 

ft  (Z3  .GE.  CMIN)  .AND.  <Z3  .LE.  CMAX))  THEN 

IF  (Z2  .LT.  CMIN)  THEN 
CV-CMIN 
ELSE 
CV-CMAX 
END  IF 

CALL  CROSSCCV.XZ.YZ.ZZ.XS.YS.ZS.XL.YL) 

CALL  CR0SS(CV,X1,Y1,Z1,X2,Y2,Z2,XQ,YQ) 

CALL  SETCOL(LCCI)) 

CALL  FILQUD(XL,YL,X3,Y3,Xl,Yl,XQ,Yq) 
**************************************************************** 

*  VERTEX  1  IS  IN  RANGE  AND  VERTEX  2  AND  3  ARE  BOTH  EITHER  * 

*  ABOVE  OR  BELOV  THE  RANGE.  * 

**************************************************************** 
ELSE  IF  ((Zl  .GE.  CMIN)  .AND.  (Zl  .LE.  CMAX)  .AND. 

ft  ((<Z2  .LT.  CMIN)  .AND.  (Z3  .LT.  CMIN))  .OR. 

ft  ( CZ2  .GT.  CMAX)  .AND.  (Z3  .GT.  CMAX))))  THEN 

IF  ((Z2  .LT.  CMIN)  .AND.  (Z3  .LT.  CMIN))  THEN 
CV-CMIN 
ELSE 
CV-CMAX 
END  IF 

CALL  CR0SS(CV,X1,Y1,Z1,X2,Y2,Z2.XL,YL) 

CALL  CR0SS(CV,X3,Y3,Z3,Xl,Yl,Zl,Xq,Yq) 

CALL  SErCOLOC(I)) 

CALL  FILTRI(Xl,Yl,XL,YL,Xq,Yq) 

**************************************************************** 

*  VERTEX  2  IS  IN  RANGE  AND  VERTEX  3  AND  1  ARE  BOTH  EITHER  * 
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111 
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*  ABOVE  OR  BELOW  THE  RANGE.  * 

**************************************************************** 

ELSE  IF  ( (Z2  .GE.  CMIN)  .AND.  (Z2  .LE.  CMAX)  .AND. 
ft  (((Z3  -LT.  CMIN)  .AND.  (Z1  .LT.  CMIN))  .OR. 

ft  ((Z3  .GT.  CMAX)  .AND.  CZ1  .GT.  CMAX))))  THEN 

IF  ((Z3  .LT.  CMIN)  .AND.  (Z1  .LT.  CMIN))  THEN 

CV=CMIN 
ELSE 
CV=CMAX 
END  IF 

CALL  CROSS (CV , X2 , Y2 , Z2 , X3 , Y3 , Z3 , XL , YL) 

CALL  CROSS (CV, XI, Y1,Z1,X2,Y2,Z2,XQ,YQ) 

CALL  SETCOLCLC(I)) 

CALL  FILTRI (X2 , Y2 , XL , YL , XQ , YQ) 

**************************************************************** 

*  VERTEX  3  IS  IN  RANGE  AND  VERTEX  1  AND  2  ARE  BOTH  EITHER  * 

*  ABOVE  OR  BELOW  THE  RANGE.  * 

**************************************************************** 
ELSE  IF  ( (Z3  .GE.  CMIN)  .AND.  (Z3  .LE.  CMAX)  .AND. 

ft  (((Zl  .LT.  CMIN)  .AND.  CZ2  .LT.  CMIN))  .OR. 

ft  ((Zl  .GT.  CMAX)  .AND.  (Z2  .GT.  CMAX))))  THEN 

IF  ((Zl  .LT.  CMIN)  .AND.  (Z2  .LT.  CMIN))  THEN 
CV=CMIN 
ELSE 
CV-CMAX 
END  IF 

CALL  CROSS (CV,X3,Y3,Z3, XI ,Y1 ,Z1,XL,YL) 

CALL  CR0SS(CV,X2,Y2,Z2,X3,Y3,Z3,XQ,YQ) 

CALL  SETC0L(LC(I)) 

CALL  FILTRI(X3,Y3,XL,YL,Xq,YQ) 

**************************************************************** 

*  VERTEX  1  IS  IN  RANGE  AND  VERTEX  2  IS  BELOW  AND  VERTEX  3  * 

*  IS  ABOVE.  * 

**************************************************************** 
ELSE  IF  ((Zl  .GE.  CMIN)  .AND.  (Zl  .LE.  CMAX)  .AND. 

ft  (Z2  .LT.  CMIN)  .AND.  (Z3  .GT.  CMAX))  THEN 

CALL  CROSS (CMIN>X1,Y1,Z1,X2,Y2,Z2,XL,YL) 

CALL  CROSS (CMIN, X2,Y2,Z2,X3,Y3,Z3,XQ,YQ) 

CALL  CROSS (CMAX, X2,Y2,Z2,X3,Y3,Z3,XR,YR) 

CALL  CROSS (CMAX, X3,Y3,Z3, XI, Y1,Z1,XS,YS) 

CALL  SETCOL(LC(I)) 

CALL  FILPNT(X1,Y1,XL,YL,XQ,YQ,XR,YR,XS,YS) 
**************************************************************** 

*  VERTEX  1  IS  IN  RANGE  AND  VERTEX  2  IS  ABOVE  AND  VERTEX  3  IS  * 

*  BELOW  RANGE.  * 

**************************************************************** 
ELSE  IF  ((Zl  .GE.  CMIN)  .AND.  (Zl  .LE.  CMAX)  .AND. 

ft  (Z2  .GT.  CMAX)  .AND.  (Z3  .LT.  CMIN))  THEN 

CALL  CROSS (CMAX, XI, Y1,Z1,X2,Y2,Z2, XL, YL) 

CALL  CROSS (CMAX, X2,Y2,Z2,X3,Y3,Z3,XQ,YQ) 

CALL  CROSS (CMIN, X2,Y2,Z2,X3,Y3,Z3,XR,YR) 

CALL  CROSS (CMIN,X3,Y3,Z3,X1 ,Y1,Z1,XS,YS) 

CALL  SETCOL(LC(I)) 

CALL  FILPNT(Xl,Yl,XL,YL,Xq,Yq,XR,YR,XS,YS) 
**************************************************************** 

*  VERTEX  2  IS  IN  RANGE  AND  VERTEX  3  IS  BELOW  AND  VERTEX  1  * 

*  IS  ABOVE.  * 

**************************************************************** 
ELSE  IF  ((Z2  .GE.  CMIN)  .AND.  (Z2  .LE.  CMAX)  .AND. 
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*  (Z3  .LT.  CMIN)  .AND.  (Z1  .GT.  CMAX))  THEN 

CALL  CROSS (CMIN, X2,Y2,Z2,X3,Y3,Z3, XL, YL) 

CALL  CROSS (CMIN ,X3,Y3,Z3,X1,Y1,Z1,XQ,YQ) 

CALL  CROSS (CMAX, X3,Y3,Z3, XI, Yl.Zi.XR.YR) 

CALL  CROSS (CMAX, XI, Yi,Zl ,X2,Y2,Z2,XS,YS) 

CALL  SETCOL(LC(I)) 

CALL  FILPNT(X2,Y2,XL,YL,XQ,YQ,XR,YR,XS,YS) 
**************************************************************** 

*  VERTEX  2  IS  IN  RANGE  AND  VERTEX  3  IS  ABOVE  AND  VERTEX  1  IS  * 

*  BELOW  RANGE.  * 

**************************************************************** 
ELSE  IF  ((Z2  .GE.  CMIN)  .AND.  (Z2  .LE.  CMAX)  .AND. 

&  (Z3  .GT.  CMAX)  .AND.  (Z1  .LT.  CMIN))  THEN 

CALL  CROSS (CMAX, X2,Y2,Z2,X3,Y3,Z3, XL, YL) 

CALL  CROSS (CMAX, X3,Y3,Z3, XI, Y1,Z1,XQ,YQ) 

CALL  CROSS (CMIN, X3,Y3,Z3, XI, Y1,Z1 ,XR,YR) 

CALL  CROSS (CMIN , XI , Y1 , Z1 , X2 , Y2 , Z2 , XS , YS) 

CALL  SETCOL(LC(I)) 

CALL  FILPNT(X2,Y2,XL,YL,Xq,YQ,XR,YR,XS,YS) 
**************************************************************** 

*  VERTEX  3  IS  IN  RANGE  AND  VERTEX  1  IS  BELOW  AND  VERTEX  2  * 

*  IS  ABOVE.  * 

**************************************************************** 
ELSE  IF  ((Z3  .GE.  CMIN)  .AND.  (Z3  .LE.  CMAX)  .AND. 

A  (Z1  .LT.  CMIN)  .AND.  (Z2  .GT.  CMAX))  THEN 

CALL  CROSS (CMIN, X3,Y3,Z3,X1,Y1,Z1, XL, YL) 

CALL  CROSS (CMIN, XI, Y1,Z1,X2,Y2,Z2,XQ,YQ) 

CALL  CROSS (CMAX, XI, Y1,Z1,X2,Y2,Z2,XR,YR) 

CALL  CROSS (CMAX , X2 ,Y2 ,Z2 ,X3 ,Y3 ,Z3,XS ,YS) 

CALL  SETCOL(LC(I)) 

CALL  FILPNT(X3,Y3,XL,YL,Xq,YQ,XR,YR,XS,YS) 
**************************************************************** 

*  VERTEX  3  IS  IN  RANGE  AND  VERTEX  1  IS  ABOVE  AND  VERTEX  2  IS  * 

*  BELOW  RANGE.  * 

**************************************************************** 
ELSE  IF  ( (Z3  .GE.  CMIN)  .AND.  (Z3  .LE.  CMAX)  .AND. 

ft  (Z1  .GT.  CMAX)  .AND.  (Z2  .LT.  CMIN))  THEN 

CALL  CROSS (CMAX, X3,Y3,Z3, XI, Y1,Z1, XL, YL) 

CALL  CROSS (CMAX , XI , Y1 , Z1 , X2 , Y2 , Z2 ,Xq , Yq) 

CALL  CROSS (CMIN, XI, Y1,Z1,X2,Y2,Z2,XR,YR) 

CALL  CROSS (CMIN, X2,Y2,Z2,X3,Y3,Z3,XS,YS) 

CALL  SETCOL(LC(I)) 

CALL  FILPNT(X3,Y3,XL,YL,Xq,Yq,XR,YR,XS,YS) 
**************************************************************** 

*  VERTEX  1  IS  BELOW  OR  ABOVE  RANGE  AND  VERTEX  2  AND  3  ARE  BOTH  * 

*  ABOVE  OR  BELOW  RANGE.  * 

**************************************************************** 
ELSE  IF  (((Zl  .LT.  CMIN)  .AND.  (Z2  .GT.  CMAX) 

ft  .AND.  (Z3  .GT.  CMAX))  .OR. 

ft  ((Zl  .GT.  CMAX)  .AND.  (Z2  .LT.  CMIN) 

ft  .AND.  (Z3  .LT.  CMIN)))  THEN 

CALL  CROSS (CMIN, XI, Y1,Z1,X2,Y2,Z2, XL, YL) 

CALL  CROSS (CMAX, XI, Yl,Zl,X2,Y2,Z2,XQ,Yq) 

CALL  CROSS (CMAX, X3,Y3,Z3, XI, Y1,Z1,XR,YR) 

CALL  CROSS (CMIN, X3,Y3,Z3, XI ,Y1,Z1,XS,YS) 

CALL  SETCOL(LC(I)) 

CALL  FILQOD(XL,YL,Xq,Yq,XR,YR,XS,YS) 
**************************************************************** 

*  VERTEX  2  IS  BELOW  OR  ABOVE  RANGE  AND  VERTEX  3  AND  1  ARE  BOTH  * 
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*  ABOVE  OR  BELOW  RANGE.  * 

**************************************************************** 
ELSE  IF  (((Z2  .LT.  CMIN)  .AND.  (Z3  .GT.  CMAX) 

&  .AND.  (Z1  .GT.  CMAX))  .OR. 

k  ( (Z2  .GT.  CMAX)  .AND.  (Z3  .LT.  CMIN) 

A  .AND.  (Z1  .LT.  CMIN)))  THEN 

CALL  CROSS (CMIN, X2,Y21Z2,X3,Y3,Z3, XL, YL) 

CALL  CROSS (CMAX , X2 , Y2 , Z2 , X3 , Y3 , Z3 , XQ , YQ) 

CALL  CROSS (CMAX , XI , VI , Z1 , X2 , Y2 , Z2 , XR , YR) 

CALL  CROSS (CMIN , XI , Y1 , Z1 , X2 , Y2 , Z2 , XS , YS) 

CALL  SETCOL(LC(I)) 

CALL  FILQUD(XL,YL,XQ,YQ,XR,VR,XS,YS) 
**************************************************************** 

*  VERTEX  3  IS  BELOW  OR  ABOVE  RANGE  AND  VERTEX  1  AND  2  ARE  BOTH  * 

*  ABOVE  OR  BELOW  RANGE.  * 

**************************************************************** 
ELSE  IF  (((Z3  .LT.  CMIN)  .AND.  (Z1  .GT.  CMAX) 

A  .AND.  (Z2  .GT.  CMAX))  .OR. 

A  ((Z3  .GT.  CMAX)  .AND.  (Z1  .LT.  CMIN) 

A  .AND.  (Z2  .LT.  CMIN)))  THEN 

CALL  CROSS (CMIN, X3,Y3,Z3, XI, Y1,Z1, XL, YL) 

CALL  CROSS (CMAX, X3, Y3, Z3 , XI ,Y1 ,Z1,XQ,YQ) 

CALL  CROSS (CMAX, X2,Y2,Z2,X3,Y3,Z3,XR,YR) 

CALL  CROSS (CMIN, X2,Y2,Z2,X3,Y3,Z3,XS,YS) 

CALL  SETCOL(LC(I)) 

CALL  FILQUD(XL,YL,XQ,YQ,XR,YR,XS,YS) 

ELSE 
END  IF 
CONTINUE 
RETURN 
END 


1  SUBROUTINE  CROSS(CV,XA,YA,ZA,XB,YB,ZB,XI ,YI) 

2  C  ****************************************************************** 


3  C  *  THIS  SUBROUTINE  COMPUTES  THE  INTERSECTION  OF  A  CONTOUR  LINE  * 

4  C  *  WITH  A  TRIANGLE  BOUNDARY  LINE.  * 

5  C  ****************************************************************** 

6  C  *  INPUTS:  * 

7  C  *  * 

8  C  *  CV  -  CONTOUR  VALUE.  * 

9  C  *  XA.YA  -  COORDINATES  OF  END  POINTS.  * 

10  C  *  XB.YB  * 

11  C  *  ZA.ZB  -  FUNCTION  VALUES  AT  THE  END  POINTS.  * 

12  C  *  * 

13  C  *  OUTPUTS:  * 

14  C  *  * 

15  C  *  XI, YI  -  INTERCEPT  COORDINATES.  * 


16  C  ****************************************************************** 

17  WA-CV-ZA 

is  VB*CV-ZB 

19  DF*(ZB-ZA) 

20  XI»(WA*XB-WB*XA)/DF 

21  YI*(WA*YB-WB*YA)/DF 

22  RETURN 

23  END 


1  SUBROUTINE  LEGEND (US, VS, NC.NL.LC, LABEL, SL,SH,DS,ITYPE) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  DRAWS  THE  LEGEND.  * 


111 


4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
61 
63 


****************************************************************** 


*  DRAW  THE  COLOR  KEY.  * 

*  * 

*  (US, VS)  -  LOWER  LEFT  CORNER  OF  LEGEND.  * 

*  NC  -  NUM3ER  OF  COLORS.  * 

*  NL  -  NUMBER  OF  LABELS.  * 

*  LABEL (NC)  -  LABEL  STRINGS.  * 

*  LC(K)  -  LABEL  RECTANGLE  COLOR  CODE.  * 

*  SL  -  SIDE  LENGTH  OF  EACH  RECTANGLE.  * 

*  SH  -  SIDE  HEIGHT  OF  EACH  RECTANGLE.  * 

*  DS  -  SPACING  BETWEEN  ADJACENT  RECTANGLES.  * 


****************************************************************** 
CHARACTERS  LABEL  (NL) 

CHARACTERS  PSC 
INTEGER  LC(NC) 

PSC=’)  stringwidth  pop  2  div  neg  0  rmoveto’ 

*************************************************************4**** 

*  DEFINE  THE  SQUARES.  * 

****************************************************************** 
IF  (ITYPE  .Eq.  1)  THEN 

**************************************************************** 
*  DRAW  A  VERTICAL  BLOCK  TYPE  LEGEND.  * 

**************************************************************** 
DO  1  1=1, NC 
U=US 

V=VS+(I-1)*(SH+DS) 

************************************************************** 

*  FILL  EACH  RECTANGLE.  * 

************************************************************** 
WRITECl ,*)  ’ gsave ’ 

WRITECl ,*)  U,V,’  moveto’ 

WRITECl ,*)  U+SL.V,’  lineto’ 

WRITE(1,*)  U+SL.V+SH, ’  lineto’ 

WRITE(1,*)  U+SL.V+SH,’  lineto’ 

WRITECl,*)  U.V+SH,’  lineto  closepath’ 

CALL  SETCOLCLC(I)) 

WRITECl,*)  '  fill  stroke’ 

WRITEC1,*)  ’grestore’ 

************************************************************** 

*  DRAW  THE  PERIMETER  AROUND  EACH  RECTANGLE.  * 

********************************************************7***** 

WRITECl,*)  ’gsave  0  setgray  0.5  setlinewidth’ 

WRITECl,*)  U,V,*  moveto’ 

WRITEd,*)  U+SL.V,’  lineto’ 

WRITE(1,*)  U+SL.V+SH, ’  lineto’ 

WRITEd,*)  U+SL.V+SH,  ’  lineto' 

WRITEd,*)  U.V+SH,’  lineto  closepath  stroke  grestore’ 
********************************************************  ***» • 

*  DRAW  THE  RECTANGLE  LABEL. 

************************************************************** 
WRITE(1,*)  ’0  setgray’ 

WRITEd,*)  ’ /Times-Roman  findfont  10  scalefont  setfont’ 
WRITECl,*)  U+SL+2 . 0 , V-3 . 0 , ’  moveto’ 

CALL  CHRLIM(LABELCI) .MINCHR.MAXCHR) 

WRITECl,*)  ’C ’//LABEL CD CMINCHR:MAXCHR)//’)  show’ 

IF  Cl  .EQ.  !'))  THEN 
WRITECl,*)  ’0  setgray’ 

WRITECl,*)  ’/Times-Roman  findfont  10  scalefont  setfont’ 
WRITECl,*)  U+SL+2. 0.V+SH-3.0,’  moveto’ 
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CALL  CHRLIMCLABELCI+1) .MINCHR, MAXCHR) 

WRITECl,*)  ’ CV/LABELCI+1) CMINCHR: MAXCHR)//’)  show’ 

ELSE 
END  IF 
CONTINUE 
ELSE 

**************************************************************** 
*  DRAW  A  HORIZONTAL  BLOCK  TYPE  LEGEND.  * 

**************************************************************** 
DO  2  1=1, NC 
U=US+(I-1)*SL 
V-VS 

************************************************************** 

*  FILL  EACH  RECTANGLE.  * 

************************************************************** 
WRITECl,*)  ’gsave’ 

WRITECl,*)  U,V,’  moveto’ 

WRITECl,*)  U+SL.V, ’  lineto* 

WRITECl,*)  U+SL.V+SH, ’  lineto’ 

WRITECl,*)  U+SL.V+SH, ’  lineto’ 

WRITECl,*)  U.V+SH, ’  lineto  closepath’ 

CALL  SETCOLCLCCD) 

WRITECl,*)  ’  fill  stroke’ 

WRITECl,*)  ’grestore’ 

************************************************************** 

*  DRAW  THE  PERIMETER  AROUND  EACH  RECTANGLE.  * 

************************************************************** 
WRITECl,*)  ’gsave  0  setgray  0.5  setlinevidth’ 

WRITECl,*)  U.V.’  moveto’ 

WRITECl,*)  U+SL.V,’  lineto’ 

WRITECl,*)  U+SL.V+SH,’  lineto’ 

WRITECl,*)  U+SL.V+SH,’  lineto’ 

WRITECl,*)  U.V+SH,’  lineto  closepath  stroke  grestore’ 
************************************************************** 

*  DRAW  THE  RECTANGLE  LABEL.  * 

************************************************************** 
WRITECl,*)  ’0  setgray’ 

WRITECl,*)  ’ /Times-Roman  findfont  10  scalefont  setfont’ 
WRITECl,*)  U,V-.9*SH, ’  moveto’ 

CALL  CHRLIMCLABELCI) , MINCHR , MAXCHR) 

WRITECl ,*)  ’ C ’ //LABELCI) CMINCHR: MAXCHR) //PSC 
WRITECl,*)  ’ C’//LABELCI) CMINCHR: MAXCHR) //’)  show’ 

IF  Cl  -EQ.  NC)  THEN 
WRITECl,*)  ’0  setgray’ 

WRITECl,*)  ’/Times-Roman  findfont  10  scalefont  setfont’ 
WRITECl,*)  U+SL,V-.9*SH, ’  moveto’ 

CALL  CHRLIMCLABELCI+I) .MINCHR, MAXCHR) 

WRITE  Cl,*)  ’ C ’ //LABEL  C 1+1 ) CMINCHR : MAXCHR) //PSC 
WRITECl,*)  ’ C’//LABELCI+1) CMINCHR: MAXCHR)//’)  show’ 

FT-SE 
END  IF 
CONTINUE 
END  IF 
RETURN 
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SUBROUTINE  CHRLIM CCS, MINCHR, MAXCHR) 
****************************************************************** 
*  THIS  SUBROUTINE  DETERMINES  THE  MINIMUM  AND  MAXIMUM  NONBLANK  * 


4  C  *  CHARACTER  IN  A  CHARACTER  STRING.  * 

5  Q  ******************************** * ****** ****** ********************* 

6  CHARACTER* (*)  CS 

7  MAX=LEN (CS) 

8  MINCHR=1 

9  MAXCHR=MAX 

10  DO  1  1=1, MAX 

11  IF  (CS(I:I)  .NE.  ’  ’)  THEN 

12  MINCHR=I 

13  GO  TO  2 

14  ELSE 

15  END  IF 

16  1  CONTINUE 

17  2  CONTINUE 

18  DO  3  I=MAX,1,-1 

19  IF  (CS(I:I)  .NE.  ’  ’)  THEN 

20  MAXCHR=I 

21  GO  TO  4 

22  ELSE 

23  END  IF 

24  3  CONTINUE 

25  4  CONTINUE 

26  RETURN 

27  END 
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SUBROUTINE  SETCOL(I) 

****************************************************************** 
*  THIS  SUBROUTINE  SETS  THE  DRAWING  COLOR.  * 

****************************************************************** 
IF  (I  .Eq.  0)  THEN 
WRITECl,*)  ’black' 

ELSE  IF  (I  .EQ.  1)  THEN 
WRITECl,*)  ’white’ 

ELSE  IF  (I  .EQ.  2)  THEN 
WRITECl,*)  ’gray-lt’ 

ELSE  IF  (I  .EQ.  3)  THEN 
WRITE ( 1 , *)  ’ gray-lt -med ’ 

ELSE  IF  (I  .EQ.  4)  THEN 
WRITECl,*)  ’gray’ 

ELSE  IF  (I  .Eq.  5)  THEN 
WRITECl,*)  ’gray-dk-med’ 

ELSE  IF  (I  .Eq.  6)  THEN 
WRITECl,*)  ’gray-dk’ 

ELSE  IF  (I  .Eq.  7)  THEN 
WRITECl,*)  ’red’ 

ELSE  IF  Cl  .Eq.  8)  THEN 
WRITECl,*)  ’magenta’ 

ELSE  IF  Cl  .Eq.  9)  THEN 
WRITECl,*)  ’green’ 

ELSE  IF  Cl  .Eq.  10)  THEN 
WRITECl,*)  ’blue’ 

ELSE  IF  Cl  .EQ.  11)  THEN 
WRITECl,*)  ’cyan’ 

ELSE  IF  Cl  .Eq.  12)  THEN 
WRITECl,*)  ’yellow’ 

ELSE  IF  Cl  -Eq.  13)  THEN 
WRITECl,*)  ’orange’ 

ELSE  IF  Cl  -EQ.  14)  THEN 
WRITECl,*)  ’brown’ 
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35  ELSE  IF  (I  .EQ.  15)  THEN 

36  WRITECl,*)  ’kakhi’ 

37  ELSE  IF  (I  .EQ.  16)  THEN 

38  WRITECl ,*)  ’blue-lt’ 

39  ELSE  IF  (I  .EQ.  17)  THEN 

40  WRITECl,*)  ’green-lt* 

41  ELSE  IF  (I  .EQ.  18)  THEN 

42  WRITECl,*)  ’green-blue’ 

43  ELSE  IF  Cl  .EQ.  19)  THEN 

44  WRITECl,*)  ’purple’ 

45  ELSE 

46  WRITECl,*)  ’white’ 

47  END  IF 

48  RETURN 

49  END 

1  SUBROUTINE  FILTRICX1,Y1,X2,Y2,X3,Y3) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  FILLS  A  TRIANGLE  WITH  THE  CURRENT  COLOR.  * 

4  C  ****************************************************************** 

5  WRITECl, 1)  X1,Y1,X2,Y2,X3,Y3, ’  filtri’ 

6  1  F0RMATC6CF6.2, IX) ,A7) 

7  RETURN 

8  END 

1  SUBROUTINE  FILqUDCXl,Yl,X2,Y2,X3,Y3,X4,Y4) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  FILLS  A  QUADRILATERAL  WITH  THE  CURRENT  COLOR.  * 

4  C  ****************************************************************** 

5  WRITECl, 1)  X1,Y1,X2,Y2,X3,Y3,X4,Y4, ’  filqud’ 

6  1  F0RMATC8CF6.2,1X),A7) 

7  RETURN 

8  END 

1  SUBROUTINE  FILPNTCX1,Y1,X2,Y2,X3,Y3,X4,Y4,X5,Y5) 

2  C  ****************************************************************** 

3  C  *  THIS  SUBROUTINE  FILLS  A  PENTAGON  WITH  THE  CURRENT  COLOR.  * 

4  C  ****************************************************************** 

5  WRITECl, 1)  X1,Y1,X2,Y2,X3,Y3,X4,Y4,X5,Y5, ’  filpnt’ 

6  1  F0RMATC10CF6.2,1X),A7) 

7  RETURN 

8  END 

1  FUNCTION  TRANS CA.B.S) 

2  TRANS*A*S+B 

3  RETURN 

4  END 
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